Merge remote branch 'origin/master' into ghc-new-co

Conflicts:
	compiler/typecheck/TcErrors.lhs
	compiler/typecheck/TcSMonad.lhs
	compiler/typecheck/TcType.lhs
	compiler/types/TypeRep.lhs

127 files changed, 1997 insertions, 1645 deletions

diff --git a/.gitignore b/.gitignore
index bbcff222d2..3e2e7f4391 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,6 +7,7 @@
 *.BAK
 *.orig
 *.prof
+*.rej
 
 *.hi
 *.hi-boot
@@ -30,6 +31,12 @@ config.status
 configure
 
 # -----------------------------------------------------------------------------
+# Ignore any overlapped darcs repos and back up files
+
+*-darcs-backup*
+_darcs/
+
+# -----------------------------------------------------------------------------
 # sub-repositories
 
 /ghc-tarballs/
@@ -79,9 +86,7 @@ configure
 /bindist-list
 /bindistprep/
 /bindisttest/HelloWorld
-/bindisttest/a/
-/bindisttest/install\ dir/
-/bindisttest/output
+/bindisttest/
 /ch01.html
 /ch02.html
 /compiler/cmm/CmmLex.hs
@@ -119,8 +124,12 @@ configure
 /docs/users_guide/users_guide.xml
 /docs/users_guide/users_guide/
 /docs/users_guide/what_glasgow_exts_does.gen.xml
+/driver/ghc/dist/
+/driver/haddock/dist/
 /driver/ghci/ghc-pkg-inplace
 /driver/ghci/ghci-inplace
+/driver/ghci/dist/
+/driver/ghci/ghci.res
 /driver/mangler/dist/ghc-asm
 /driver/mangler/dist/ghc-asm.prl
 /driver/package.conf
@@ -128,7 +137,7 @@ configure
 /driver/split/dist/ghc-split
 /driver/split/dist/ghc-split.prl
 /driver/stamp-pkg-conf-rts
-/extra-gcc-opts
+/settings
 /ghc.spec
 /ghc/ghc-bin.cabal
 /ghc/stage1/
@@ -150,6 +159,8 @@ configure
 /libffi/package.conf.inplace
 /libffi/package.conf.inplace.raw
 /libffi/stamp*
+/libffi/package.conf.install
+/libffi/package.conf.install.raw
 /libraries/bin-package-db/GNUmakefile
 /libraries/bin-package-db/ghc.mk
 /libraries/bootstrapping.conf
@@ -185,6 +196,8 @@ configure
 /rts/package.conf.inplace.raw
 /rts/sm/Evac_thr.c
 /rts/sm/Scav_thr.c
+/rts/package.conf.install
+/rts/package.conf.install.raw
 /stage3.package.conf
 /testsuite_summary.txt
 /testlog
@@ -218,3 +231,4 @@ configure
 /utils/runghc/runhaskell
 /utils/runstdtest/runstdtest
 /utils/unlit/unlit
+
diff --git a/HACKING b/HACKING
index be9eec298b..8ceff18881 100644
--- a/HACKING
+++ b/HACKING
@@ -21,10 +21,15 @@ The GHC Developer's Wiki
   Quick Start for developers
 
      http://hackage.haskell.org/trac/ghc/wiki/Building/Hacking
-   
+
      This section on the wiki will get you up and running with a
-     serviceable build tree in no time:
-  
+     serviceable build tree in no time.
+
+     Don't skip this!  By default, GHC builds with all optimizations
+     and profiling; most hackers will want a quicker build, so creating
+     a mk/build.mk file and knowing how to rebuild only parts of GHC is
+     very important.
+
      This is part of the "Building GHC" section of the wiki, which
      has more detailed information on GHC's build system should you
      need it.
diff --git a/MAKEHELP b/MAKEHELP
index 85497e984f..c14767f113 100644
--- a/MAKEHELP
+++ b/MAKEHELP
@@ -25,12 +25,6 @@ Common commands:
 
      Shows the targets available in <dir>
 
-  make html
-  make pdf
-  make ps
-
-     Make documentation
-
   make install
 
      Installs GHC, libraries and tools under $(prefix)
diff --git a/aclocal.m4 b/aclocal.m4
index e09bda8440..7433873279 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -94,14 +94,10 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
     AC_MSG_CHECKING([Setting up $2, $3, $4 and $5])
     case $$1 in
     i386-apple-darwin)
-        # By default, gcc on OS X will generate SSE
-        # instructions, which need things 16-byte aligned,
-        # but we don't 16-byte align things. Thus drop
-        # back to generic i686 compatibility. Trac #2983.
-        $2="$$2 -march=i686 -m32"
-        $3="$$3 -march=i686 -m32"
+        $2="$$2 -m32"
+        $3="$$3 -m32"
         $4="$$4 -arch i386"
-        $5="$$5 -march=i686 -m32"
+        $5="$$5 -m32"
         ;;
     x86_64-apple-darwin)
         $2="$$2 -m64"
@@ -109,6 +105,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
         $4="$$4 -arch x86_64"
         $5="$$5 -m64"
         ;;
+    alpha-*)
+        # 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.
+        $2="$$2 -w -mieee -D_REENTRANT"
+        $3="$$3 -w -mieee -D_REENTRANT"
+        $5="$$5 -w -mieee -D_REENTRANT"
+        ;;
+    hppa*)
+        # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
+        # (very nice, but too bad the HP /usr/include files don't agree.)
+        $2="$$2 -D_HPUX_SOURCE"
+        $3="$$3 -D_HPUX_SOURCE"
+        $5="$$5 -D_HPUX_SOURCE"
+        ;;
     esac
 
     # If gcc knows about the stack protector, turn it off.
@@ -185,8 +196,8 @@ AC_DEFUN([FP_EVAL_STDERR],
 # --------------------
 # XXX
 #
-# $1 = the command to look for
-# $2 = the variable to set
+# $1 = the variable to set
+# $2 = the command to look for
 #
 AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG],
 [
@@ -624,7 +635,7 @@ AC_SUBST([ArArgs], ["$fp_prog_ar_args"])
 # FP_PROG_AR_NEEDS_RANLIB
 # -----------------------
 # Sets the output variable RANLIB to "ranlib" if it is needed and found,
-# to ":" otherwise.
+# to "true" otherwise.
 AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],
 [AC_REQUIRE([FP_PROG_AR_IS_GNU])
 AC_REQUIRE([FP_PROG_AR_ARGS])
@@ -644,38 +655,12 @@ fi])
 if test $fp_cv_prog_ar_needs_ranlib = yes; then
    AC_PROG_RANLIB
 else
-  RANLIB=":"
+  RANLIB="true"
   AC_SUBST([RANLIB])
 fi
 ])# FP_PROG_AR_NEEDS_RANLIB
 
 
-# FP_PROG_AR_SUPPORTS_INPUT
-# -------------------------
-# Sets the output variable ArSupportsInput to "-input" or "", depending on
-# whether ar supports -input flag is supported or not.
-AC_DEFUN([FP_PROG_AR_SUPPORTS_INPUT],
-[AC_REQUIRE([FP_PROG_AR_IS_GNU])
-AC_REQUIRE([FP_PROG_AR_ARGS])
-AC_CACHE_CHECK([whether $fp_prog_ar_raw supports -input], [fp_cv_prog_ar_supports_input],
-[fp_cv_prog_ar_supports_input=no
-if test $fp_prog_ar_is_gnu = no; then
-  rm -f conftest*
-  touch conftest.lst
-  if FP_EVAL_STDERR(["$fp_prog_ar_raw" $fp_prog_ar_args conftest.a -input conftest.lst]) >/dev/null; then
-    test -s conftest.err || fp_cv_prog_ar_supports_input=yes
-  fi
-  rm -f conftest*
-fi])
-if test $fp_cv_prog_ar_supports_input = yes; then
-    ArSupportsInput="-input"
-else
-    ArSupportsInput=""
-fi
-AC_SUBST([ArSupportsInput])
-])# FP_PROG_AR_SUPPORTS_INPUT
-
-
 dnl
 dnl AC_SHEBANG_PERL - can we she-bang perl?
 dnl
@@ -695,38 +680,30 @@ rm -f conftest
 ])])
 
 
-# FP_HAVE_GCC
+# FP_GCC_VERSION
 # -----------
 # 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],
+# output variable GccVersion.
+AC_DEFUN([FP_GCC_VERSION],
 [AC_REQUIRE([AC_PROG_CC])
-if test -z "$GCC"; then
-   fp_have_gcc=NO
-else
-   fp_have_gcc=YES
-fi
-if test "$fp_have_gcc" = "NO" -a -d $srcdir/ghc; then
+if test -z "$GCC"
+then
   AC_MSG_ERROR([gcc is required])
 fi
 GccLT34=
 AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version],
-[if test "$fp_have_gcc" = "YES"; then
-   fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/g'`"
-   FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.0],
-     [AC_MSG_ERROR([Need at least gcc version 3.0 (3.4+ recommended)])])
-   # See #2770: gcc 2.95 doesn't work any more, apparently.  There probably
-   # isn't a very good reason for that, but for now just make configure
-   # fail.
-   FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES)
- else
-   fp_cv_gcc_version="not-installed"
- fi
+[
+    fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/g'`"
+    FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.0],
+                        [AC_MSG_ERROR([Need at least gcc version 3.0 (3.4+ recommended)])])
+    # See #2770: gcc 2.95 doesn't work any more, apparently.  There probably
+    # isn't a very good reason for that, but for now just make configure
+    # fail.
+    FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES)
 ])
-AC_SUBST([HaveGcc], [$fp_have_gcc])
 AC_SUBST([GccVersion], [$fp_cv_gcc_version])
 AC_SUBST(GccLT34)
-])# FP_HAVE_GCC
+])# FP_GCC_VERSION
 
 dnl Small feature test for perl version. Assumes PerlCmd
 dnl contains path to perl binary.
@@ -1098,7 +1075,7 @@ AC_SUBST([GhcPkgCmd])
 # integer wrap around. (Trac #952)
 #
 AC_DEFUN([FP_GCC_EXTRA_FLAGS],
-[AC_REQUIRE([FP_HAVE_GCC])
+[AC_REQUIRE([FP_GCC_VERSION])
 AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts],
 [fp_cv_gcc_extra_opts=
  FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [3.4],
@@ -1120,7 +1097,7 @@ if test "$RELEASE" = "NO"; then
         AC_MSG_RESULT(given $PACKAGE_VERSION)
     elif test -d .git; then
         changequote(, )dnl
-        ver_date=`git log -n 1 --date=short --pretty=format:%ci | sed "s/^.*\([0-9][0-9][0-9][0-9]\)-\([0-9][0-9]\)-\([0-9][0-9]\).*$/\1\2\3/"`
+        ver_date=`git log -n 1 --date=short --pretty=format:%ci | cut -d ' ' -f 1 | tr -d -`
         if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else
         changequote([, ])dnl
                 AC_MSG_ERROR([failed to detect version date: check that git is in your path])
@@ -1532,6 +1509,21 @@ case "$1" in
   esac
 ])
 
+# BOOTSTRAPPING_GHC_INFO_FIELD
+# --------------------------------
+# If the bootstrapping compiler is >= 7.1, then set the variable
+# $1 to the value of the ghc --info field $2. Otherwise, set it to
+# $3.
+AC_DEFUN([BOOTSTRAPPING_GHC_INFO_FIELD],[
+if test $GhcCanonVersion -ge 701
+then
+    $1=`"$WithGhc" --info | grep "^ ,(\"$2\"," | sed -e 's/.*","//' -e 's/")$//'`
+else
+    $1=$3
+fi
+AC_SUBST($1)
+])
+
 # LIBRARY_VERSION(lib)
 # --------------------------------
 # Gets the version number of a library.
diff --git a/boot b/boot
index ae57381636..0b67b17f0b 100755
--- a/boot
+++ b/boot
@@ -3,10 +3,18 @@
 use strict;
 
 use Cwd;
+use File::Path 'rmtree';
+use File::Basename;
 
 my %required_tag;
+my $validate;
+my $curdir;
 
 $required_tag{"-"} = 1;
+$validate = 0;
+
+$curdir = &cwd()
+    or die "Can't find current directory: $!";
 
 while ($#ARGV ne -1) {
     my $arg = shift @ARGV;
@@ -14,59 +22,212 @@ while ($#ARGV ne -1) {
     if ($arg =~ /^--required-tag=(.*)/) {
         $required_tag{$1} = 1;
     }
+    elsif ($arg =~ /^--validate$/) {
+        $validate = 1;
+    }
     else {
         die "Bad arg: $arg";
     }
 }
 
+sub sanity_check_line_endings {
+    local $/ = undef;
+    open FILE, "packages" or die "Couldn't open file: $!";
+    binmode FILE;
+    my $string = <FILE>;
+    close FILE;
+
+    if ($string =~ /\r/) {
+        print STDERR <<EOF;
+Found ^M in packages.
+Perhaps you need to run
+    git config --global core.autocrlf false
+and re-check out the tree?
+EOF
+        exit 1;
+    }
+}
+
+sub sanity_check_tree {
+    my $tag;
+    my $dir;
+
+    # Check that we have all boot packages.
+    open PACKAGES, "< packages";
+    while (<PACKAGES>) {
+        if (/^#/) {
+            # Comment; do nothing
+        }
+        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+ +[^ ]+$/) {
+            $dir = $1;
+            $tag = $2;
+
+            # If $tag is not "-" then it is an optional repository, so its
+            # absence isn't an error.
+            if (defined($required_tag{$tag})) {
+                # We would like to just check for a .git directory here,
+                # but in an lndir tree we avoid making .git directories,
+                # so it doesn't exist. We therefore require that every repo
+                # has a LICENSE file instead.
+                if (! -f "$dir/LICENSE") {
+                    print STDERR "Error: $dir/LICENSE doesn't exist.\n";
+                    die "Maybe you haven't done './sync-all get'?";
+                }
+            }
+        }
+        else {
+            die "Bad line in packages file: $_";
+        }
+    }
+    close PACKAGES;
+}
+
 # Create libraries/*/{ghc.mk,GNUmakefile}
-system("/usr/bin/perl", "-w", "boot-pkgs") == 0
-    or die "Running boot-pkgs failed: $?";
+sub boot_pkgs {
+    my @library_dirs = ();
+    my @tarballs = glob("libraries/tarballs/*");
 
-my $tag;
-my $dir;
-my $curdir;
+    my $tarball;
+    my $package;
+    my $stamp;
 
-$curdir = &cwd()
-    or die "Can't find current directory: $!";
+    for $tarball (@tarballs) {
+        $package = $tarball;
+        $package =~ s#^libraries/tarballs/##;
+        $package =~ s/-[0-9.]*(-snapshot)?\.tar\.gz$//;
 
-# Check that we have all boot packages.
-open PACKAGES, "< packages";
-while (<PACKAGES>) {
-    if (/^#/) {
-        # Comment; do nothing
+        # Sanity check, so we don't rmtree the wrong thing below
+        if (($package eq "") || ($package =~ m#[/.\\]#)) {
+            die "Bad package name: $package";
+        }
+
+        if (-d "libraries/$package/_darcs") {
+            print "Ignoring libraries/$package as it looks like a darcs checkout\n"
+        }
+        elsif (-d "libraries/$package/.git") {
+            print "Ignoring libraries/$package as it looks like a git checkout\n"
+        }
+        else {
+            if (! -d "libraries/stamp") {
+                mkdir "libraries/stamp";
+            }
+            $stamp = "libraries/stamp/$package";
+            if ((! -d "libraries/$package") || (! -f "$stamp")
+             || ((-M "libraries/stamp/$package") > (-M $tarball))) {
+                print "Unpacking $package\n";
+                if (-d "libraries/$package") {
+                    &rmtree("libraries/$package")
+                        or die "Can't remove libraries/$package: $!";
+                }
+                mkdir "libraries/$package"
+                    or die "Can't create libraries/$package: $!";
+                system ("sh", "-c", "cd 'libraries/$package' && { cat ../../$tarball | gzip -d | tar xf - ; } && mv */* .") == 0
+                    or die "Failed to unpack $package";
+                open STAMP, "> $stamp"
+                    or die "Failed to open stamp file: $!";
+                close STAMP
+                    or die "Failed to close stamp file: $!";
+            }
+        }
     }
-    elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+ +[^ ]+$/) {
-        $dir = $1;
-        $tag = $2;
-        
-        # If $tag is not "-" then it is an optional repository, so its
-        # absence isn't an error.
-        if (defined($required_tag{$tag})) {
-            # We would like to just check for a .git directory here,
-            # but in an lndir tree we avoid making .git directories,
-            # so it doesn't exist. We therefore require that every repo
-            # has a LICENSE file instead.
-            if (! -f "$dir/LICENSE") {
-                print STDERR "Error: $dir/LICENSE doesn't exist.\n";
-                die "Maybe you haven't done './sync-all get'?";
+
+    for $package (glob "libraries/*/") {
+        $package =~ s/\/$//;
+        my $pkgs = "$package/ghc-packages";
+        if (-f $pkgs) {
+            open PKGS, "< $pkgs"
+                or die "Failed to open $pkgs: $!";
+            while (<PKGS>) {
+                chomp;
+                s/\r//g;
+                if (/.+/) {
+                    push @library_dirs, "$package/$_";
+                }
             }
         }
+        else {
+            push @library_dirs, $package;
+        }
     }
-    else {
-        die "Bad line in packages file: $_";
+
+    for $package (@library_dirs) {
+        my $dir = &basename($package);
+        my @cabals = glob("$package/*.cabal");
+        if ($#cabals > 0) {
+            die "Too many .cabal file in $package\n";
+        }
+        if ($#cabals eq 0) {
+            my $cabal = $cabals[0];
+            my $pkg;
+            my $top;
+            if (-f $cabal) {
+                $pkg = $cabal;
+                $pkg =~ s#.*/##;
+                $pkg =~ s/\.cabal$//;
+                $top = $package;
+                $top =~ s#[^/]+#..#g;
+                $dir = $package;
+                $dir =~ s#^libraries/##g;
+
+                print "Creating $package/ghc.mk\n";
+                open GHCMK, "> $package/ghc.mk"
+                    or die "Opening $package/ghc.mk failed: $!";
+                print GHCMK "${package}_PACKAGE = ${pkg}\n";
+                print GHCMK "${package}_dist-install_GROUP = libraries\n";
+                print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(STAGE2_PACKAGES)),2,1)))\n";
+                close GHCMK
+                    or die "Closing $package/ghc.mk failed: $!";
+
+                print "Creating $package/GNUmakefile\n";
+                open GNUMAKEFILE, "> $package/GNUmakefile"
+                    or die "Opening $package/GNUmakefile failed: $!";
+                print GNUMAKEFILE "dir = ${package}\n";
+                print GNUMAKEFILE "TOP = ${top}\n";
+                print GNUMAKEFILE "include \$(TOP)/mk/sub-makefile.mk\n";
+                print GNUMAKEFILE "FAST_MAKE_OPTS += stage=0\n";
+                close GNUMAKEFILE
+                    or die "Closing $package/GNUmakefile failed: $!";
+            }
+        }
     }
 }
-close PACKAGES;
 
 # autoreconf everything that needs it.
-foreach $dir (".", glob("libraries/*/")) {
-    if (-f "$dir/configure.ac") {
-        print "Booting $dir\n";
-        chdir $dir or die "can't change to $dir: $!";
-        system("autoreconf") == 0
-            or die "Running autoreconf failed with exitcode $?";
-        chdir $curdir or die "can't change to $curdir: $!";
+sub autoreconf {
+    my $dir;
+
+    foreach $dir (".", glob("libraries/*/")) {
+        if (-f "$dir/configure.ac") {
+            print "Booting $dir\n";
+            chdir $dir or die "can't change to $dir: $!";
+            system("autoreconf") == 0
+                or die "Running autoreconf failed with exitcode $?";
+            chdir $curdir or die "can't change to $curdir: $!";
+        }
     }
 }
 
+sub checkBuildMk {
+    if ($validate eq 0 && ! -f "mk/build.mk") {
+        print <<EOF;
+
+WARNING: You don't have a mk/build.mk file.
+
+By default a standard GHC build will be done, which uses optimisation
+and builds the profiling libraries. This will take a long time, so may
+not be what you want if you are developing GHC or the libraries, rather
+than simply building it to use it.
+
+For information on creating a mk/build.mk file, please see:
+    http://hackage.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
+
+EOF
+    }
+}
+
+&sanity_check_line_endings();
+&sanity_check_tree();
+&boot_pkgs();
+&autoreconf();
+&checkBuildMk();
+
diff --git a/boot-pkgs b/boot-pkgs
deleted file mode 100644
index de3008cf92..0000000000
--- a/boot-pkgs
+++ /dev/null
@@ -1,114 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use File::Path 'rmtree';
-use File::Basename;
-
-my @library_dirs = ();
-my @tarballs = glob("libraries/tarballs/*");
-
-my $tarball;
-my $package;
-my $stamp;
-
-for $tarball (@tarballs) {
-    $package = $tarball;
-    $package =~ s#^libraries/tarballs/##;
-    $package =~ s/-[0-9.]*(-snapshot)?\.tar\.gz$//;
-
-    # Sanity check, so we don't rmtree the wrong thing below
-    if (($package eq "") || ($package =~ m#[/.\\]#)) {
-        die "Bad package name: $package";
-    }
-
-    if (-d "libraries/$package/_darcs") {
-        print "Ignoring libraries/$package as it looks like a darcs checkout\n"
-    }
-    elsif (-d "libraries/$package/.git") {
-        print "Ignoring libraries/$package as it looks like a git checkout\n"
-    }
-    else {
-        if (! -d "libraries/stamp") {
-            mkdir "libraries/stamp";
-        }
-        $stamp = "libraries/stamp/$package";
-        if ((! -d "libraries/$package") || (! -f "$stamp")
-         || ((-M "libraries/stamp/$package") > (-M $tarball))) {
-            print "Unpacking $package\n";
-            if (-d "libraries/$package") {
-                &rmtree("libraries/$package")
-                    or die "Can't remove libraries/$package: $!";
-            }
-            mkdir "libraries/$package"
-                or die "Can't create libraries/$package: $!";
-            system ("sh", "-c", "cd 'libraries/$package' && { cat ../../$tarball | gzip -d | tar xf - ; } && mv */* .") == 0
-                or die "Failed to unpack $package";
-            open STAMP, "> $stamp"
-                or die "Failed to open stamp file: $!";
-            close STAMP
-                or die "Failed to close stamp file: $!";
-        }
-    }
-}
-
-for $package (glob "libraries/*/") {
-    $package =~ s/\/$//;
-    my $pkgs = "$package/ghc-packages";
-    if (-f $pkgs) {
-        open PKGS, "< $pkgs"
-            or die "Failed to open $pkgs: $!";
-        while (<PKGS>) {
-            chomp;
-            s/\r//g;
-            if (/.+/) {
-                push @library_dirs, "$package/$_";
-            }
-        }
-    }
-    else {
-        push @library_dirs, $package;
-    }
-}
-
-for $package (@library_dirs) {
-    my $dir = &basename($package);
-    my @cabals = glob("$package/*.cabal");
-    if ($#cabals > 0) {
-        die "Too many .cabal file in $package\n";
-    }
-    if ($#cabals eq 0) {
-        my $cabal = $cabals[0];
-        my $pkg;
-        my $top;
-        if (-f $cabal) {
-            $pkg = $cabal;
-            $pkg =~ s#.*/##;
-            $pkg =~ s/\.cabal$//;
-            $top = $package;
-            $top =~ s#[^/]+#..#g;
-            $dir = $package;
-            $dir =~ s#^libraries/##g;
-
-            print "Creating $package/ghc.mk\n";
-            open GHCMK, "> $package/ghc.mk"
-                or die "Opening $package/ghc.mk failed: $!";
-            print GHCMK "${package}_PACKAGE = ${pkg}\n";
-            print GHCMK "${package}_dist-install_GROUP = libraries\n";
-            print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(STAGE2_PACKAGES)),2,1)))\n";
-            close GHCMK
-                or die "Closing $package/ghc.mk failed: $!";
-
-            print "Creating $package/GNUmakefile\n";
-            open GNUMAKEFILE, "> $package/GNUmakefile"
-                or die "Opening $package/GNUmakefile failed: $!";
-            print GNUMAKEFILE "dir = ${package}\n";
-            print GNUMAKEFILE "TOP = ${top}\n";
-            print GNUMAKEFILE "include \$(TOP)/mk/sub-makefile.mk\n";
-            print GNUMAKEFILE "FAST_MAKE_OPTS += stage=0\n";
-            close GNUMAKEFILE
-                or die "Closing $package/GNUmakefile failed: $!";
-        }
-    }
-}
-
diff --git a/compiler/Makefile.local b/compiler/Makefile.local
deleted file mode 100644
index 1d5345114b..0000000000
--- a/compiler/Makefile.local
+++ /dev/null
@@ -1,75 +0,0 @@
-# Local GHC-build-tree customization for Cabal makefiles.  We want to build
-# libraries using flags that the user has put in build.mk/validate.mk and
-# appropriate flags for Mac OS X deployment targets.
-
-# Careful here: including boilerplate.mk breaks things, because paths.mk and
-# opts.mk overrides some of the variable settings in the Cabal Makefile, so
-# we just include config.mk and custom-settings.mk.
-TOP=..
-SAVE_GHC := $(GHC)
-SAVE_AR  := $(AR)
-SAVE_LD  := $(LD)
-include $(TOP)/mk/config.mk
-include $(TOP)/mk/custom-settings.mk
-GHC := $(SAVE_GHC)
-AR  := $(SAVE_AR)
-LD  := $(SAVE_LD)
-
-# Now add flags from the GHC build system to the Cabal build:
-GHC_CC_OPTS += $(addprefix -optc, $(MACOSX_DEPLOYMENT_CC_OPTS))
-GHC_OPTS    += $(SRC_HC_OPTS)
-GHC_OPTS    += $(GhcHcOpts)
-GHC_OPTS    += $(GhcStage$(stage)HcOpts)
-GHC_OPTS    += $(addprefix -optc, $(MACOSX_DEPLOYMENT_CC_OPTS))
-LIB_LD_OPTS += $(addprefix -optl, $(MACOSX_DEPLOYMENT_LD_OPTS))
-
-# XXX These didn't work in the old build system, according to the
-# comment at least. We should actually handle them properly at some
-# point:
-
-# Some .hs files #include other source files, but since ghc -M doesn't spit out
-# these dependencies we have to include them manually.
-
-# We don't add dependencies on HsVersions.h, ghcautoconf.h, or ghc_boot_platform.h,
-# because then modifying one of these files would force recompilation of everything,
-# which is probably not what you want.  However, it does mean you have to be
-# careful to recompile stuff you need if you reconfigure or change HsVersions.h.
-
-# Aargh, these don't work properly anyway, because GHC's recompilation checker
-# just reports "compilation NOT required".  Do we have to add -fforce-recomp for each
-# of these .hs files?  I haven't done anything about this yet.
-
-# $(odir)/codeGen/Bitmap.$(way_)o     :  ../includes/MachDeps.h
-# $(odir)/codeGen/CgCallConv.$(way_)o :  ../includes/StgFun.h
-# $(odir)/codeGen/CgProf.$(way_)o     :  ../includes/MachDeps.h
-# $(odir)/codeGen/CgProf.$(way_)o     :  ../includes/Constants.h
-# $(odir)/codeGen/CgProf.$(way_)o     :  ../includes/DerivedConstants.h
-# $(odir)/codeGen/CgTicky.$(way_)o    :  ../includes/DerivedConstants.h
-# $(odir)/codeGen/ClosureInfo.$(way_)o    :  ../includes/MachDeps.h
-# $(odir)/codeGen/SMRep.$(way_)o      :  ../includes/MachDeps.h
-# $(odir)/codeGen/SMRep.$(way_)o      :  ../includes/ClosureTypes.h
-# $(odir)/ghci/ByteCodeAsm.$(way_)o   :  ../includes/Bytecodes.h
-# $(odir)/ghci/ByteCodeFFI.$(way_)o   :  nativeGen/NCG.h
-# $(odir)/ghci/ByteCodeInstr.$(way_)o :  ../includes/MachDeps.h
-# $(odir)/ghci/ByteCodeItbls.$(way_)o :  ../includes/ClosureTypes.h
-# $(odir)/ghci/ByteCodeItbls.$(way_)o :  nativeGen/NCG.h
-# $(odir)/main/Constants.$(way_)o     :  ../includes/MachRegs.h
-# $(odir)/main/Constants.$(way_)o     :  ../includes/Constants.h
-# $(odir)/main/Constants.$(way_)o     :  ../includes/MachDeps.h
-# $(odir)/main/Constants.$(way_)o     :  ../includes/DerivedConstants.h
-# $(odir)/main/Constants.$(way_)o     :  ../includes/GHCConstants.h
-# $(odir)/nativeGen/AsmCodeGen.$(way_)o   :  nativeGen/NCG.h
-# $(odir)/nativeGen/MachCodeGen.$(way_)o  :  nativeGen/NCG.h
-# $(odir)/nativeGen/MachCodeGen.$(way_)o  : ../includes/MachDeps.h
-# $(odir)/nativeGen/MachInstrs.$(way_)o   :  nativeGen/NCG.h
-# $(odir)/nativeGen/MachRegs.$(way_)o :  nativeGen/NCG.h
-# $(odir)/nativeGen/MachRegs.$(way_)o :  ../includes/MachRegs.h
-# $(odir)/nativeGen/PositionIndependentCode.$(way_)o :  nativeGen/NCG.h
-# $(odir)/nativeGen/PprMach.$(way_)o  :  nativeGen/NCG.h
-# $(odir)/nativeGen/RegAllocInfo.$(way_)o :  nativeGen/NCG.h
-# $(odir)/typecheck/TcForeign.$(way_)o    :  nativeGen/NCG.h
-# $(odir)/utils/Binary.$(way_)o       :  ../includes/MachDeps.h
-# $(odir)/utils/FastMutInt.$(way_)o   :  ../includes/MachDeps.h
-# $(PRIMOP_BITS) is defined in Makefile
-# $(odir)/prelude/PrimOp.o: $(PRIMOP_BITS)
-
diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index c4bdba209c..03f541e505 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -155,6 +155,7 @@ addBootSuffixLocn locn
 \begin{code}
 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 newtype ModuleName = ModuleName FastString
+    deriving Typeable
 
 instance Uniquable ModuleName where
   getUnique (ModuleName nm) = getUnique nm
@@ -175,8 +176,6 @@ instance Binary ModuleName where
   put_ bh (ModuleName fs) = put_ bh fs
   get bh = do fs <- get bh; return (ModuleName fs)
 
-INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
-
 instance Data ModuleName where
   -- don't traverse?
   toConstr _   = abstractConstr "ModuleName"
@@ -224,7 +223,7 @@ data Module = Module {
    modulePackageId :: !PackageId,  -- pkg-1.0
    moduleName      :: !ModuleName  -- A.B.C
   }
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Typeable)
 
 instance Uniquable Module where
   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
@@ -236,8 +235,6 @@ instance Binary Module where
   put_ bh (Module p n) = put_ bh p >> put_ bh n
   get bh = do p <- get bh; n <- get bh; return (Module p n)
 
-INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
-
 instance Data Module where
   -- don't traverse?
   toConstr _   = abstractConstr "Module"
@@ -280,7 +277,7 @@ pprPackagePrefix p mod = getPprStyle doc
 
 \begin{code}
 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
-newtype PackageId = PId FastString deriving( Eq )
+newtype PackageId = PId FastString deriving( Eq, Typeable )
     -- here to avoid module loops with PackageConfig
 
 instance Uniquable PackageId where
@@ -291,8 +288,6 @@ instance Uniquable PackageId where
 instance Ord PackageId where
   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
-INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
-
 instance Data PackageId where
   -- don't traverse?
   toConstr _   = abstractConstr "PackageId"
diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index 70cf298a4f..f2ae963891 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -106,6 +106,7 @@ data Name = Name {
 --(note later when changing Int# -> FastInt: is that still true about UNPACK?)
 		n_loc  :: !SrcSpan	-- Definition site
 	    }
+    deriving Typeable
 
 -- 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
@@ -363,8 +364,6 @@ instance Uniquable Name where
 instance NamedThing Name where
     getName n = n
 
-INSTANCE_TYPEABLE0(Name,nameTc,"Name")
-
 instance Data Name where
   -- don't traverse?
   toConstr _   = abstractConstr "Name"
diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index e2acaf7109..bef9e928fd 100644
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -48,7 +48,12 @@ import Data.Data
 \begin{code}
 type NameSet = UniqSet Name
 
-INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")
+-- TODO: These Data/Typeable instances look very dubious. Surely either
+-- UniqFM should have the instances, or this should be a newtype?
+
+nameSetTc :: TyCon
+nameSetTc = mkTyCon "NameSet"
+instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] }
 
 instance Data NameSet where
   gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
@@ -176,7 +181,7 @@ duDefs dus = foldr get emptyNameSet dus
     get (Just d1, _u1) d2 = d1 `unionNameSets` d2
 
 allUses :: DefUses -> Uses
--- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned
+-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
 allUses dus = foldr get emptyNameSet dus
   where
     get (_d1, u1) u2 = u1 `unionNameSets` u2
@@ -184,8 +189,7 @@ allUses dus = foldr get emptyNameSet dus
 duUses :: DefUses -> Uses
 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
 -- but remove 'Defs' on the way
-duUses dus
-  = foldr get emptyNameSet dus
+duUses 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)
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index f02ae8d0da..5489ea7e26 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -209,6 +209,7 @@ data OccName = OccName
     { occNameSpace  :: !NameSpace
     , occNameFS     :: !FastString
     }
+    deriving Typeable
 \end{code}
 
 
@@ -221,8 +222,6 @@ instance Ord OccName where
     compare (OccName sp1 s1) (OccName sp2 s2) 
 	= (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
 
-INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")
-
 instance Data OccName where
   -- don't traverse?
   toConstr _   = abstractConstr "OccName"
diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 5dcdabe605..d2cbd7f07c 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -185,8 +185,6 @@ instance Outputable SrcLoc where
 
     ppr (UnhelpfulLoc s)  = ftext s
 
-INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")
-
 instance Data SrcSpan where
   -- don't traverse?
   toConstr _   = abstractConstr "SrcSpan"
@@ -237,10 +235,10 @@ data SrcSpan
 				-- also used to indicate an empty span
 
 #ifdef DEBUG
-  deriving (Eq, Show)	-- Show is used by Lexer.x, becuase we
-			-- derive Show for Token
+  deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
+                                -- derive Show for Token
 #else
-  deriving Eq
+  deriving (Eq, Typeable)
 #endif
 
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs
index 3376d0e501..3c3ff7f440 100644
--- a/compiler/basicTypes/Var.lhs
+++ b/compiler/basicTypes/Var.lhs
@@ -145,6 +145,7 @@ data Var
 	idScope    :: IdScope,
 	id_details :: IdDetails,	-- Stable, doesn't change
 	id_info    :: IdInfo }		-- Unstable, updated by simplifier
+    deriving Typeable
 
 data IdScope	-- See Note [GlobalId/LocalId]
   = GlobalId 
@@ -205,8 +206,6 @@ instance Ord Var where
     a >	 b = realUnique a >#  realUnique b
     a `compare` b = varUnique a `compare` varUnique b
 
-INSTANCE_TYPEABLE0(Var,varTc,"Var")
-
 instance Data Var where
   -- don't traverse?
   toConstr _   = abstractConstr "Var"
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index c151a26391..901b13b342 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -101,7 +101,7 @@ module CLabel (
         hasCAF,
 	infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
-        isMathFun,
+        isMathFun, isCas,
  	isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
 	pprCLabel
@@ -590,9 +590,17 @@ maybeAsmTemp (AsmTempLabel uq) 		= Just uq
 maybeAsmTemp _ 	    	       		= Nothing
 
 
+-- | Check whether a label corresponds to our cas function.
+--      We #include the prototype for this, so we need to avoid
+--      generating out own C prototypes.
+isCas :: CLabel -> Bool
+isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
+isCas _                     = False
+
+
 -- | Check whether a label corresponds to a C function that has 
 --      a prototype in a system header somehere, or is built-in
---      to the C compiler. For these labels we abovoid generating our
+--      to the C compiler. For these labels we avoid generating our
 --      own C prototypes.
 isMathFun :: CLabel -> Bool
 isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 2e9f952f7b..54b4b11662 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -9,10 +9,11 @@
 #endif
 
 module Cmm
-  ( CmmGraph(..), CmmBlock
+  ( CmmGraph, GenCmmGraph(..), CmmBlock
   , CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop
   , CmmReplGraph, CmmFwdRewrite, CmmBwdRewrite
 
+  , modifyGraph
   , lastNode, replaceLastNode, insertBetween
   , ofBlockMap, toBlockMap, insertBlock
   , ofBlockList, toBlockList, bodyToBlockList
@@ -41,7 +42,8 @@ import Panic
 -------------------------------------------------
 -- CmmBlock, CmmGraph and Cmm
 
-data CmmGraph = CmmGraph { g_entry :: BlockId, g_graph :: Graph CmmNode C C }
+type CmmGraph = GenCmmGraph CmmNode
+data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
 type CmmBlock = Block CmmNode C C
 
 type CmmReplGraph e x = FuelUniqSM (Maybe (Graph CmmNode e x))
@@ -56,6 +58,9 @@ type CmmTop       = GenCmmTop CmmStatic CmmTopInfo CmmGraph
 -------------------------------------------------
 -- Manipulating CmmGraphs
 
+modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
+modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
+
 toBlockMap :: CmmGraph -> LabelMap CmmBlock
 toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
 
@@ -150,26 +155,26 @@ insertBetween b ms succId = insert $ lastNode b
 -- Running dataflow analysis and/or rewrites
 
 -- Constructing forward and backward analysis-only pass
-analFwd    :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdPass m CmmNode f
-analBwd    :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdPass m CmmNode f
+analFwd    :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdPass m n f
+analBwd    :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdPass m n f
 
 analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
 analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
 
 -- Constructing forward and backward analysis + rewrite pass
-analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdRewrite m CmmNode f -> FwdPass m CmmNode f
-analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdRewrite m CmmNode f -> BwdPass m CmmNode f
+analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdRewrite m n f -> FwdPass m n f
+analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdRewrite m n f -> BwdPass m n f
 
 analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
 analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
 
 -- Running forward and backward dataflow analysis + optional rewrite
-dataflowPassFwd :: CmmGraph -> [(BlockId, f)] -> FwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
+dataflowPassFwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> FwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
 
-dataflowPassBwd :: CmmGraph -> [(BlockId, f)] -> BwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
+dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> BwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index 64c77beb15..6e9710065f 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -113,12 +113,13 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        --------------- Stack layout ----------------
        slotEnv <- run $ liveSlotAnal g
+       let spEntryMap = getSpEntryMap entry_off g
        mbpprTrace "live slot analysis results: " (ppr slotEnv) $ return ()
-       let areaMap = layout procPoints slotEnv entry_off g
+       let areaMap = layout procPoints spEntryMap slotEnv entry_off g
        mbpprTrace "areaMap" (ppr areaMap) $ return ()
 
        ------------  Manifest the stack pointer --------
-       g  <- run $ manifestSP areaMap entry_off g
+       g  <- run $ manifestSP spEntryMap areaMap entry_off g
        dump Opt_D_dump_cmmz "after manifestSP" g
        -- UGH... manifestSP can require updates to the procPointMap.
        -- We can probably do something quicker here for the update...
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 3ae2996213..55a5b73ac5 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -42,8 +42,8 @@ data CmmExpr
   | CmmRegOff CmmReg Int	
 	-- CmmRegOff reg i
 	--        ** is shorthand only, meaning **
-	-- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-	--	where rep = cmmRegType reg
+	-- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
+	--	where rep = typeWidth (cmmRegType reg)
 
 instance Eq CmmExpr where	-- Equality ignores the types
   CmmLit l1    	    == CmmLit l2    	 = l1==l2
@@ -124,6 +124,8 @@ cmmExprType (CmmReg reg)      	= cmmRegType reg
 cmmExprType (CmmMachOp op args) = machOpResultType op (map cmmExprType args)
 cmmExprType (CmmRegOff reg _)   = cmmRegType reg
 cmmExprType (CmmStackSlot _ _)  = bWord -- an address
+-- Careful though: what is stored at the stack slot may be bigger than
+-- an address
 
 cmmLitType :: CmmLit -> CmmType
 cmmLitType (CmmInt _ width)     = cmmBits  width
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 95b1eef6a3..32fead337e 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -24,7 +24,6 @@ import OldPprCmm()
 import Constants
 import FastString
 
-import Control.Monad
 import Data.Maybe
 
 -- -----------------------------------------------------------------------------
@@ -70,8 +69,10 @@ lintCmmBlock labels (BasicBlock id stmts)
 lintCmmExpr :: CmmExpr -> CmmLint CmmType
 lintCmmExpr (CmmLoad expr rep) = do
   _ <- lintCmmExpr expr
-  when (widthInBytes (typeWidth rep) >= wORD_SIZE) $
-     cmmCheckWordAddress expr
+  -- Disabled, if we have the inlining phase before the lint phase,
+  -- we can have funny offsets due to pointer tagging. -- EZY
+  -- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $
+  --   cmmCheckWordAddress expr
   return rep
 lintCmmExpr expr@(CmmMachOp op args) = do
   tys <- mapM lintCmmExpr args
@@ -99,14 +100,14 @@ isOffsetOp _ = False
 
 -- This expression should be an address from which a word can be loaded:
 -- check for funny-looking sub-word offsets.
-cmmCheckWordAddress :: CmmExpr -> CmmLint ()
-cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
+_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
+_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
   = cmmLintDubiousWordOffset e
-cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
+_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
   = cmmLintDubiousWordOffset e
-cmmCheckWordAddress _
+_cmmCheckWordAddress _
   = return ()
 
 -- No warnings for unaligned arithmetic with the node register,
@@ -152,6 +153,7 @@ lintTarget (CmmPrim {})    = return ()
 
 checkCond :: CmmExpr -> CmmLint ()
 checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
 checkCond expr = cmmLintErr (hang (text "expression is not a conditional:") 2
 				    (ppr expr))
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 8c2498e5f8..4dc7e3214f 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -396,13 +396,15 @@ stmt	:: { ExtCode }
 	| NAME '(' exprs0 ')' ';'
 		{% stmtMacro $1 $3  }
 	| 'switch' maybe_range expr '{' arms default '}'
-		{ doSwitch $2 $3 $5 $6 }
+		{ do as <- sequence $5; doSwitch $2 $3 as $6 }
 	| 'goto' NAME ';'
 		{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
 	| 'jump' expr maybe_actuals ';'
 		{ do e1 <- $2; e2 <- sequence $3; stmtEC (CmmJump e1 e2) }
         | 'return' maybe_actuals ';'
 		{ do e <- sequence $2; stmtEC (CmmReturn e) }
+	| 'if' bool_expr 'goto' NAME
+		{ do l <- lookupLabel $4; cmmRawIf $2 l }
 	| 'if' bool_expr '{' body '}' else 	
 		{ cmmIfThenElse $2 $4 $6 }
 
@@ -441,12 +443,16 @@ maybe_range :: { Maybe (Int,Int) }
 	: '[' INT '..' INT ']'	{ Just (fromIntegral $2, fromIntegral $4) }
 	| {- empty -}		{ Nothing }
 
-arms	:: { [([Int],ExtCode)] }
+arms	:: { [ExtFCode ([Int],Either BlockId ExtCode)] }
 	: {- empty -}			{ [] }
 	| arm arms			{ $1 : $2 }
 
-arm	:: { ([Int],ExtCode) }
-	: 'case' ints ':' '{' body '}'	{ ($2, $5) }
+arm	:: { ExtFCode ([Int],Either BlockId ExtCode) }
+	: 'case' ints ':' arm_body	{ do b <- $4; return ($2, b) }
+
+arm_body :: { ExtFCode (Either BlockId ExtCode) }
+	: '{' body '}'			{ return (Right $2) }
+	| 'goto' NAME ';'		{ do l <- lookupLabel $2; return (Left l) }
 
 ints	:: { [Int] }
 	: INT				{ [ fromIntegral $1 ] }
@@ -458,6 +464,8 @@ default :: { Maybe ExtCode }
 	-- 'default' branches
 	| {- empty -}			{ Nothing }
 
+-- Note: OldCmm doesn't support a first class 'else' statement, though
+-- CmmNode does.
 else 	:: { ExtCode }
 	: {- empty -}			{ nopEC }
 	| 'else' '{' body '}'		{ $3 }
@@ -952,6 +960,10 @@ cmmIfThenElse cond then_part else_part = do
      -- fall through to join
      code (labelC join_id)
 
+cmmRawIf cond then_id = do
+    c <- cond
+    emitCond c then_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
@@ -991,7 +1003,7 @@ emitCond (e1 `BoolAnd` e2) then_id = do
 -- 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)]
+doSwitch :: Maybe (Int,Int) -> ExtFCode CmmExpr -> [([Int],Either BlockId ExtCode)]
          -> Maybe ExtCode -> ExtCode
 doSwitch mb_range scrut arms deflt
    = do 
@@ -1018,12 +1030,12 @@ doSwitch mb_range scrut arms deflt
 	-- 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
+	emitArm :: ([Int],Either BlockId ExtCode) -> ExtFCode [(Int,BlockId)]
+	emitArm (ints,Left blockid) = return [ (i,blockid) | i <- ints ]
+	emitArm (ints,Right code) = do
 	   blockid <- forkLabelledCodeEC code
 	   return [ (i,blockid) | i <- ints ]
 
-
 -- -----------------------------------------------------------------------------
 -- Putting it all together
 
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index d0d54d909d..fbe979b9ab 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -378,6 +378,8 @@ add_CopyOuts protos procPoints g = foldGraphBlocks mb_copy_out (return mapEmpty)
 -- 4. build info tables for the procedures -- and update the info table for
 --    the SRTs in the entry procedure as well.
 -- Input invariant: A block should only be reachable from a single ProcPoint.
+-- ToDo: use the _ret naming convention that the old code generator
+-- used. -- EZY
 splitAtProcPoints :: CLabel -> ProcPointSet-> ProcPointSet -> BlockEnv Status ->
                      CmmTop -> FuelUniqSM [CmmTop]
 splitAtProcPoints entry_label callPPs procPoints procMap
diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs
index 01543c444e..c0fb6af037 100644
--- a/compiler/cmm/CmmStackLayout.hs
+++ b/compiler/cmm/CmmStackLayout.hs
@@ -13,7 +13,7 @@
 
 module CmmStackLayout
     ( SlotEnv, liveSlotAnal, liveSlotTransfers, removeLiveSlotDefs
-    , layout, manifestSP, igraph, areaBuilder
+    , getSpEntryMap, layout, manifestSP, igraph, areaBuilder
     , stubSlotsOnDeath ) -- to help crash early during debugging
 where
 
@@ -195,7 +195,7 @@ liveLastOut env l =
 type Set x = Map x ()
 data IGraphBuilder n =
   Builder { foldNodes     :: forall z. SubArea -> (n -> z -> z) -> z -> z
-          , _wordsOccupied :: AreaMap -> AreaMap -> n -> [Int]
+          , _wordsOccupied :: AreaSizeMap -> AreaMap -> n -> [Int]
           }
 
 areaBuilder :: IGraphBuilder Area
@@ -242,10 +242,13 @@ igraph builder env g = foldr interfere Map.empty (postorderDfs g)
 -- what's the highest offset (in bytes) used in each Area?
 -- We'll need to allocate that much space for each Area.
 
+-- Mapping of areas to area sizes (not offsets!)
+type AreaSizeMap = AreaMap
+
 -- JD: WHY CAN'T THIS COME FROM THE slot-liveness info?
-getAreaSize :: ByteOff -> CmmGraph -> AreaMap
+getAreaSize :: ByteOff -> CmmGraph -> AreaSizeMap
   -- The domain of the returned mapping consists only of Areas
-  -- used for (a) variable spill slots, and (b) parameter passing ares for calls
+  -- used for (a) variable spill slots, and (b) parameter passing areas for calls
 getAreaSize entry_off g =
   foldGraphBlocks (foldBlockNodesF3 (first, add_regslots, last))
               (Map.singleton (CallArea Old) entry_off) g
@@ -266,10 +269,11 @@ getAreaSize entry_off g =
 	-- The 'max' is important.  Two calls, to f and g, might share a common
 	-- continuation (and hence a common CallArea), but their number of overflow
 	-- parameters might differ.
+        -- EZY: Ought to use insert with combining function...
 
 
 -- Find the Stack slots occupied by the subarea's conflicts
-conflictSlots :: Ord x => IGPair x -> AreaMap -> AreaMap -> SubArea -> Set Int
+conflictSlots :: Ord x => IGPair x -> AreaSizeMap -> AreaMap -> SubArea -> Set Int
 conflictSlots (ig, Builder foldNodes wordsOccupied) areaSize areaMap subarea =
   foldNodes subarea foldNode Map.empty
   where foldNode n set = Map.foldRightWithKey conflict set $ Map.findWithDefault Map.empty n ig
@@ -278,10 +282,10 @@ conflictSlots (ig, Builder foldNodes wordsOccupied) areaSize areaMap subarea =
         liveInSlots areaMap n set = foldr setAdd set (wordsOccupied areaSize areaMap n)
         setAdd w s = Map.insert w () s
 
--- Find any open space on the stack, starting from the offset.
--- If the area is a CallArea or a spill slot for a pointer, then it must
--- be word-aligned.
-freeSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> Int
+-- Find any open space for 'area' on the stack, starting from the
+-- 'offset'.  If the area is a CallArea or a spill slot for a pointer,
+-- then it must be word-aligned.
+freeSlotFrom :: Ord x => IGPair x -> AreaSizeMap -> Int -> AreaMap -> Area -> Int
 freeSlotFrom ig areaSize offset areaMap area =
   let size = Map.lookup area areaSize `orElse` 0
       conflicts = conflictSlots ig areaSize areaMap (area, size, size)
@@ -299,11 +303,24 @@ freeSlotFrom ig areaSize offset areaMap area =
   in findSpace (align (offset + size)) size
 
 -- Find an open space on the stack, and assign it to the area.
-allocSlotFrom :: Ord x => IGPair x -> AreaMap -> Int -> AreaMap -> Area -> AreaMap
+allocSlotFrom :: Ord x => IGPair x -> AreaSizeMap -> Int -> AreaMap -> Area -> AreaMap
 allocSlotFrom ig areaSize from areaMap area =
   if Map.member area areaMap then areaMap
   else Map.insert area (freeSlotFrom ig areaSize from areaMap area) areaMap
 
+-- Figure out all of the offsets from the slot location; this will be
+-- non-zero for procpoints.
+type SpEntryMap = BlockEnv Int
+getSpEntryMap :: Int -> CmmGraph -> SpEntryMap
+getSpEntryMap entry_off g@(CmmGraph {g_entry = entry})
+    = foldGraphBlocks add_sp_off (mapInsert entry entry_off emptyBlockMap) g
+  where add_sp_off :: CmmBlock -> BlockEnv Int -> BlockEnv Int
+        add_sp_off b env =
+          case lastNode b of
+            CmmCall {cml_cont=Just succ, cml_ret_args=off} -> mapInsert succ off env
+            CmmForeignCall {succ=succ}                     -> mapInsert succ wORD_SIZE env
+            _                                              -> env
+
 -- | Greedy stack layout.
 -- Compute liveness, build the interference graph, and allocate slots for the areas.
 -- We visit each basic block in a (generally) forward order.
@@ -326,12 +343,16 @@ allocSlotFrom ig areaSize from areaMap area =
 -- Note: The stack pointer only has to be younger than the youngest live stack slot
 -- at proc points. Otherwise, the stack pointer can point anywhere.
 
-layout :: ProcPointSet -> SlotEnv -> ByteOff -> CmmGraph -> AreaMap
+layout :: ProcPointSet -> SpEntryMap -> SlotEnv -> ByteOff -> CmmGraph -> AreaMap
 -- The domain of the returned map includes an Area for EVERY block
 -- including each block that is not the successor of a call (ie is not a proc-point)
--- That's how we return the info of what the SP should be at the entry of every block
+-- That's how we return the info of what the SP should be at the entry of every non
+-- procpoint block.  However, note that procpoint blocks have their
+-- /slot/ stored, which is not necessarily the value of the SP on entry
+-- to the block (in fact, it probably isn't, due to argument passing).
+-- See [Procpoint Sp offset]
 
-layout procPoints env entry_off g =
+layout procPoints spEntryMap env entry_off g =
   let ig = (igraph areaBuilder env g, areaBuilder)
       env' bid = mapLookup bid env `orElse` panic "unknown blockId in igraph"
       areaSize = getAreaSize entry_off g
@@ -370,21 +391,87 @@ layout procPoints env entry_off g =
       allocMid m areaMap = foldSlotsDefd alloc' (foldSlotsUsed alloc' areaMap m) m
       allocLast bid l areaMap =
         foldr (setSuccSPs inSp) areaMap' (successors l)
-        where inSp = expectJust "sp in" $ Map.lookup (CallArea (Young bid)) areaMap
+        where inSp = slot + spOffset -- [Procpoint Sp offset]
+              -- If it's not in the map, we should use our previous
+              -- calculation unchanged.
+              spOffset = mapLookup bid spEntryMap `orElse` 0
+              slot = expectJust "slot in" $ Map.lookup (CallArea (Young bid)) areaMap
               areaMap' = foldSlotsDefd alloc' (foldSlotsUsed alloc' areaMap l) l
       alloc' areaMap (a@(RegSlot _), _, _) = allocVarSlot areaMap a
       alloc' areaMap _ = areaMap
 
-      initMap = Map.insert (CallArea (Young (g_entry g))) 0 $
-                  Map.insert (CallArea Old) 0 Map.empty
-                        
+      initMap = Map.insert (CallArea (Young (g_entry g))) 0
+              . Map.insert (CallArea Old)                 0
+              $ Map.empty
+
       areaMap = foldl layoutAreas initMap (postorderDfs g)
   in -- pprTrace "ProcPoints" (ppr procPoints) $
-        -- pprTrace "Area SizeMap" (ppr areaSize) $
-         -- pprTrace "Entry SP" (ppr entrySp) $
-           -- pprTrace "Area Map" (ppr areaMap) $
+     -- pprTrace "Area SizeMap" (ppr areaSize) $
+     -- pprTrace "Entry offset" (ppr entry_off) $
+     -- pprTrace "Area Map" (ppr areaMap) $
      areaMap
 
+{- Note [Procpoint Sp offset]
+
+The calculation of inSp is a little tricky.  (Un)fortunately, if you get
+it wrong, you will get inefficient but correct code.  You know you've
+got it wrong if the generated stack pointer bounces up and down for no
+good reason.
+
+Why can't we just set inSp to the location of the slot?  (This is what
+the code used to do.)  The trouble is when we actually hit the proc
+point the start of the slot will not be the same as the actual Sp due
+to argument passing:
+
+  a:
+      I32[(young<b> + 4)] = cde;
+      // Stack pointer is moved to young end (bottom) of young<b> for call
+      // +-------+
+      // | arg 1 |
+      // +-------+ <- Sp
+      call (I32[foobar::I32])(...) returns to Just b (4) (4) with update frame 4;
+  b:
+      // After call, stack pointer is above the old end (top) of
+      // young<b> (the difference is spOffset)
+      // +-------+ <- Sp
+      // | arg 1 |
+      // +-------+
+
+If we blithely set the Sp to be the same as the slot (the young end of
+young<b>), an adjustment will be necessary when we go to the next block.
+This is wasteful.  So, instead, for the next block after a procpoint,
+the actual Sp should be set to the same as the true Sp when we just
+entered the procpoint.  Then manifestSP will automatically do the right
+thing.
+
+Questions you may ask:
+
+1. Why don't we need to change the mapping for the procpoint itself?
+   Because manifestSP does its own calculation of the true stack value,
+   manifestSP will notice the discrepancy between the actual stack
+   pointer and the slot start, and adjust all of its memory accesses
+   accordingly.  So the only problem is when we adjust the Sp in
+   preparation for the successor block; that's why this code is here and
+   not in setSuccSPs.
+
+2. Why don't we make the procpoint call area and the true offset match
+   up?  If we did that, we would never use memory above the true value
+   of the stack pointer, thus wasting all of the stack we used to store
+   arguments.  You might think that some clever changes to the slot
+   offsets, using negative offsets, might fix it, but this does not make
+   semantic sense.
+
+3. If manifestSP is already calculating the true stack value, why we can't
+   do this trick inside manifestSP itself?  The reason is that if two
+   branches join with inconsistent SPs, one of them has to be fixed: we
+   can't know what the fix should be without already knowing what the
+   chosen location of SP is on the next successor.  (This is
+   the "succ already knows incoming SP" case), This calculation cannot
+   be easily done in manifestSP, since it processes the nodes
+   /backwards/.  So we need to have figured this out before we hit
+   manifestSP.
+-}
+
 -- After determining the stack layout, we can:
 -- 1. Replace references to stack Areas with addresses relative to the stack
 --    pointer.
@@ -394,8 +481,8 @@ layout procPoints env entry_off g =
 --    stack pointer to be younger than the live values on the stack at proc points.
 -- 3. Compute the maximum stack offset used in the procedure and replace
 --    the stack high-water mark with that offset.
-manifestSP :: AreaMap -> ByteOff -> CmmGraph -> FuelUniqSM CmmGraph
-manifestSP areaMap entry_off g@(CmmGraph {g_entry=entry}) =
+manifestSP :: SpEntryMap -> AreaMap -> ByteOff -> CmmGraph -> FuelUniqSM CmmGraph
+manifestSP spEntryMap areaMap entry_off g@(CmmGraph {g_entry=entry}) =
   ofBlockMap entry `liftM` foldl replB (return mapEmpty) (postorderDfs g)
   where slot a = -- pprTrace "slot" (ppr a) $
                    Map.lookup a areaMap `orElse` panic "unallocated Area"
@@ -404,13 +491,6 @@ manifestSP areaMap entry_off g@(CmmGraph {g_entry=entry}) =
         sp_high = maxSlot slot g
         proc_entry_sp = slot (CallArea Old) + entry_off
 
-        add_sp_off :: CmmBlock -> BlockEnv Int -> BlockEnv Int
-        add_sp_off b env =
-          case lastNode b of
-            CmmCall {cml_cont=Just succ, cml_ret_args=off} -> mapInsert succ off env
-            CmmForeignCall {succ=succ}                     -> mapInsert succ wORD_SIZE env
-            _                                              -> env
-        spEntryMap = foldGraphBlocks add_sp_off (mapInsert entry entry_off emptyBlockMap) g
         spOffset id = mapLookup id spEntryMap `orElse` 0
 
         sp_on_entry id | id == entry = proc_entry_sp
@@ -427,10 +507,26 @@ manifestSP areaMap entry_off g@(CmmGraph {g_entry=entry}) =
           where spIn = sp_on_entry (entryLabel block)
 
                 middle spOff m = mapExpDeep (replSlot spOff) m
+                -- XXX there shouldn't be any global registers in the
+                -- CmmCall, so there shouldn't be any slots in
+                -- CmmCall... check that...
                 last   spOff l = mapExpDeep (replSlot spOff) l
                 replSlot spOff (CmmStackSlot a i) = CmmRegOff (CmmGlobal Sp) (spOff - (slot a + i))
                 replSlot _ (CmmLit CmmHighStackMark) = -- replacing the high water mark
                   CmmLit (CmmInt (toInteger (max 0 (sp_high - proc_entry_sp))) (typeWidth bWord))
+                -- Invariant: Sp is always greater than SpLim.  Thus, if
+                -- the high water mark is zero, we can optimize away the
+                -- conditional branch.  Relies on dead code elimination
+                -- to get rid of the dead GC blocks.
+                -- EZY: Maybe turn this into a guard that checks if a
+                -- statement is stack-check ish?  Maybe we should make
+                -- an actual mach-op for it, so there's no chance of
+                -- mixing this up with something else...
+                replSlot _ (CmmMachOp (MO_U_Lt _)
+                              [CmmMachOp (MO_Sub _)
+                                         [ CmmReg (CmmGlobal Sp)
+                                         , CmmLit (CmmInt 0 _)],
+                               CmmReg (CmmGlobal SpLim)]) = CmmLit (CmmInt 0 wordWidth)
                 replSlot _ e = e
 
                 replLast :: MaybeC C (CmmNode C O) -> [CmmNode O O] -> CmmNode O C -> FuelUniqSM [CmmBlock]
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 69b481b501..c9e422fb4e 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -24,7 +24,7 @@ module MkGraph
          , copyInOflow, copyInSlot, copyOutOflow, copyOutSlot
   -- Reexport of needed Cmm stuff
   , Convention(..), ForeignConvention(..), ForeignTarget(..)
-  , CmmStackInfo(..), CmmTopInfo(..), CmmGraph(..)
+  , CmmStackInfo(..), CmmTopInfo(..), CmmGraph, GenCmmGraph(..)
   , Cmm, CmmTop
   )
 where
diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index 8d3a06b29b..f624c1c7b6 100644
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -21,9 +21,7 @@ import Data.IORef
 import Control.Monad
 import StaticFlags (opt_Fuel)
 import UniqSupply
-#ifdef DEBUG
 import Panic
-#endif
 
 import Compiler.Hoopl
 import Compiler.Hoopl.GHC (getFuel, setFuel)
@@ -53,7 +51,6 @@ anyFuelLeft :: OptimizationFuel -> Bool
 oneLessFuel :: OptimizationFuel -> OptimizationFuel
 unlimitedFuel :: OptimizationFuel
 
-#ifdef DEBUG
 newtype OptimizationFuel = OptimizationFuel Int
   deriving Show
 
@@ -63,17 +60,6 @@ amountOfFuel (OptimizationFuel f) = f
 anyFuelLeft (OptimizationFuel f) = f > 0
 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
 unlimitedFuel = OptimizationFuel infiniteFuel
-#else
--- type OptimizationFuel = State# () -- would like this, but it won't work
-data OptimizationFuel = OptimizationFuel
-  deriving Show
-tankFilledTo _ = OptimizationFuel
-amountOfFuel _ = maxBound
-
-anyFuelLeft _ = True
-oneLessFuel _ = OptimizationFuel
-unlimitedFuel = OptimizationFuel
-#endif
 
 data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass :: String }
 newtype FuelUniqSM a = FUSM { unFUSM :: FuelState -> UniqSM (a, FuelState) }
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 10f4e8bacf..d363cef50b 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -248,7 +248,7 @@ pprStmt stmt = case stmt of
                 | CmmNeverReturns <- ret ->
                     let myCall = pprCall (pprCLabel lbl) cconv results args safety
                     in (real_fun_proto lbl, myCall)
-                | not (isMathFun lbl) ->
+                | not (isMathFun lbl || isCas lbl) ->
                     let myCall = braces (
                                      pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
                                   $$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes
index 0852711f96..e787f18b17 100644
--- a/compiler/cmm/cmm-notes
+++ b/compiler/cmm/cmm-notes
@@ -15,14 +15,11 @@ Things to do:
 	This will fix the spill before stack check problem but only really as a side

 	effect. A 'real fix' probably requires making the spiller know about sp checks.

 

- - There is some silly stuff happening with the Sp. We end up with code like:

-   Sp = Sp + 8; R1 = _vwf::I64; Sp = Sp -8

-	Seems to be perhaps caused by the issue above but also maybe a optimisation

-	pass needed?

+   EZY: I don't understand this comment. David Terei, can you clarify?

 

- - Proc pass all arguments on the stack, adding more code and slowing down things

-   a lot. We either need to fix this or even better would be to get rid of

-	proc points.

+ - Proc points pass all arguments on the stack, adding more code and

+   slowing down things a lot. We either need to fix this or even better

+   would be to get rid of proc points.

 

  - CmmInfo.cmmToRawCmm uses Old.Cmm, so it is called after converting Cmm.Cmm to

    Old.Cmm. We should abstract it to work on both representations, it needs only to

@@ -32,7 +29,7 @@ Things to do:
    we could convert codeGen/StgCmm* clients to the Hoopl's semantics?

    It's all deeply unsatisfactory.

 

- - Improve preformance of Hoopl.

+ - Improve performance of Hoopl.

 

    A nofib comparison of -fasm vs -fnewcodegen nofib compilation parameters

    (using the same ghc-cmm branch +libraries compiled by the old codegenerator)

@@ -50,6 +47,9 @@ Things to do:
 

    So we generate a bit better code, but it takes us longer!

 

+   EZY: Also importantly, Hoopl uses dramatically more memory than the

+   old code generator.

+

  - Are all blockToNodeList and blockOfNodeList really needed? Maybe we could

    splice blocks instead?

 

@@ -57,7 +57,7 @@ Things to do:
    a block catenation function would be probably nicer than blockToNodeList

    / blockOfNodeList combo.

 

- - loweSafeForeignCall seems too lowlevel. Just use Dataflow. After that

+ - lowerSafeForeignCall seems too lowlevel. Just use Dataflow. After that

    delete splitEntrySeq from HooplUtils.

 

  - manifestSP seems to touch a lot of the graph representation. It is

@@ -76,6 +76,9 @@ Things to do:
    calling convention, and the code for calling foreign calls is generated

 

  - AsmCodeGen has a generic Cmm optimiser; move this into new pipeline

+   EZY (2011-04-16): The mini-inliner has been generalized and ported,

+   but the constant folding and other optimizations need to still be

+   ported.

 

  - AsmCodeGen has post-native-cg branch eliminator (shortCutBranches);

    we ultimately want to share this with the Cmm branch eliminator.

@@ -113,7 +116,7 @@ Things to do:
  - See "CAFs" below; we want to totally refactor the way SRTs are calculated

 

  - Pull out Areas into its own module

-   Parameterise AreaMap

+   Parameterise AreaMap (note there are type synonyms in CmmStackLayout!)

    Add ByteWidth = Int

    type SubArea    = (Area, ByteOff, ByteWidth) 

    ByteOff should not be defined in SMRep -- that is too high up the hierarchy

@@ -293,8 +296,8 @@ cpsTop:
        insert spills/reloads across 

 	   LastCalls, and 

 	   Branches to proc-points

-     Now sink those reloads:

-     - CmmSpillReload.insertLateReloads

+     Now sink those reloads (and other instructions):

+     - CmmSpillReload.rewriteAssignments

      - CmmSpillReload.removeDeadAssignmentsAndReloads

 

   * CmmStackLayout.stubSlotsOnDeath

@@ -344,7 +347,7 @@ to J that way. This is an awkward choice.  (We think that we currently
 never pass variables to join points via arguments.)

 

 Furthermore, there is *no way* to pass q to J in a register (other

-than a paramter register).

+than a parameter register).

 

 What we want is to do register allocation across the whole caboodle.

 Then we could drop all the code that deals with the above awkward

diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 81a65f7325..7a7bf48b92 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -105,7 +105,7 @@ mkModuleInit dflags cost_centre_info this_mod hpc_info
 
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitSimpleProc (mkPlainModuleInitLabel this_mod) $ return ()
+        ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
 
         ; whenC (this_mod == mainModIs dflags) $
              emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index fa3dcfed83..2bfe1876ba 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -25,6 +25,7 @@ import StgCmmTicky
 
 import MkGraph
 import CmmExpr
+import CmmDecl
 import CLabel
 import PprCmm
 
@@ -181,7 +182,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
         ; initCostCentres cost_centre_info
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitSimpleProc (mkPlainModuleInitLabel this_mod) $ emptyAGraph
+        ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
         }
 
 ---------------------------------------------------------------
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index b28f3eba3f..0daa6befc4 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -365,6 +365,20 @@ addTickHsExpr (HsWrap w e) =
 		(return w)
 		(addTickHsExpr e)	-- explicitly no tick on inside
 
+addTickHsExpr (HsArrApp	 e1 e2 ty1 arr_ty lr) = 
+        liftM5 HsArrApp
+	       (addTickLHsExpr e1)
+	       (addTickLHsExpr e2)
+	       (return ty1)
+	       (return arr_ty)
+	       (return lr)
+
+addTickHsExpr (HsArrForm e fix cmdtop) = 
+        liftM3 HsArrForm
+	       (addTickLHsExpr e)
+	       (return fix)
+	       (mapM (liftL (addTickHsCmdTop)) cmdtop)
+
 addTickHsExpr e@(HsType _) = return e
 
 -- Others dhould never happen in expression content.
@@ -558,7 +572,7 @@ addTickHsCmd (HsLet binds c) =
 addTickHsCmd (HsDo cxt stmts last_exp srcloc) = do
         (stmts', last_exp') <- addTickLCmdStmts' stmts (addTickLHsCmd last_exp)
 	return (HsDo cxt stmts' last_exp' srcloc)
-  where
+
 addTickHsCmd (HsArrApp	 e1 e2 ty1 arr_ty lr) = 
         liftM5 HsArrApp
 	       (addTickLHsExpr e1)
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index a7a353d66e..e26149c902 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -108,8 +108,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cBooterVersion        = "$(GhcVersion)"'                     >> $@
 	@echo 'cStage                :: String'                             >> $@
 	@echo 'cStage                = show (STAGE :: Int)'                 >> $@
-	@echo 'cCcOpts               :: [String]'                           >> $@
-	@echo 'cCcOpts               = words "$(CONF_CC_OPTS_STAGE$*)"'     >> $@
 	@echo 'cGccLinkerOpts        :: [String]'                           >> $@
 	@echo 'cGccLinkerOpts        = words "$(CONF_GCC_LINKER_OPTS_STAGE$*)"' >> $@
 	@echo 'cLdLinkerOpts         :: [String]'                           >> $@
@@ -134,8 +132,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cLeadingUnderscore    = "$(LeadingUnderscore)"'              >> $@
 	@echo 'cRAWCPP_FLAGS         :: String'                             >> $@
 	@echo 'cRAWCPP_FLAGS         = "$(RAWCPP_FLAGS)"'                   >> $@
-	@echo 'cGCC                  :: String'                             >> $@
-	@echo 'cGCC                  = "$(WhatGccIsCalled)"'                >> $@
 	@echo 'cMKDLL                :: String'                             >> $@
 	@echo 'cMKDLL                = "$(BLD_DLL)"'                        >> $@
 	@echo 'cLdIsGNULd            :: String'                             >> $@
@@ -162,8 +158,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cGHC_SYSMAN_PGM       = "$(GHC_SYSMAN)"'                     >> $@
 	@echo 'cGHC_SYSMAN_DIR       :: String'                             >> $@
 	@echo 'cGHC_SYSMAN_DIR       = "$(GHC_SYSMAN_DIR)"'                 >> $@
-	@echo 'cGHC_PERL             :: String'                             >> $@
-	@echo 'cGHC_PERL             = "$(GHC_PERL)"'                       >> $@
 	@echo 'cDEFAULT_TMPDIR       :: String'                             >> $@
 	@echo 'cDEFAULT_TMPDIR       = "$(DEFAULT_TMPDIR)"'                 >> $@
 	@echo 'cRelocatableBuild     :: Bool'                               >> $@
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 050d680d6c..884661f39c 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -569,10 +569,10 @@ newVar = liftTcM . newFlexiTyVarTy
 type RttiInstantiation = [(TcTyVar, TyVar)]
    -- Associates the typechecker-world meta type variables 
    -- (which are mutable and may be refined), to their 
-   -- debugger-world RuntimeUnkSkol counterparts.
+   -- debugger-world RuntimeUnk counterparts.
    -- If the TcTyVar has not been refined by the runtime type
    -- elaboration, then we want to turn it back into the
-   -- original RuntimeUnkSkol
+   -- original RuntimeUnk
 
 -- | Returns the instantiated type scheme ty', and the 
 --   mapping from new (instantiated) -to- old (skolem) type variables
@@ -1130,9 +1130,9 @@ zonkRttiType = zonkType (mkZonkTcTyVar zonk_unbound_meta)
     zonk_unbound_meta tv 
       = ASSERT( isTcTyVar tv )
         do { tv' <- skolemiseUnboundMetaTyVar tv RuntimeUnk
-	     -- This is where RuntimeUnkSkols are born: 
+	     -- This is where RuntimeUnks are born: 
 	     -- otherwise-unconstrained unification variables are
-	     -- turned into RuntimeUnkSkols as they leave the
+	     -- turned into RuntimeUnks as they leave the
 	     -- typechecker's monad
            ; return (mkTyVarTy tv') }
 
diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 11d1dcb080..1a1e935c48 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -679,16 +679,12 @@ okInstDclSig (TypeSig _ _)   = False
 okInstDclSig (FixSig _)      = False
 okInstDclSig _ 	             = True
 
-sigForThisGroup :: NameSet -> LSig Name -> Bool
-sigForThisGroup ns sig
-  = case sigName sig of
-	Nothing -> False
-	Just n  -> n `elemNameSet` ns
-
 sigName :: LSig name -> Maybe name
+-- Used only in Haddock
 sigName (L _ sig) = sigNameNoLoc sig
 
 sigNameNoLoc :: Sig name -> Maybe name    
+-- Used only in Haddock
 sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
 sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
 sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 345ec32ef3..53d2949aab 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -3,15 +3,7 @@
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 
-
-
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
 {-# LANGUAGE DeriveDataTypeable #-}
 
 -- | Abstract syntax of global declarations.
@@ -630,15 +622,15 @@ instance OutputableBndr name
                   (ppr new_or_data <+> 
 		   (if isJust typats then ptext (sLit "instance") else empty) <+>
 		   pp_decl_head (unLoc context) ltycon tyvars typats <+> 
-		   ppr_sig mb_sig)
+		   ppr_sigx mb_sig)
 		  (pp_condecls condecls)
 		  derivings
       where
-	ppr_sig Nothing = empty
-	ppr_sig (Just kind) = dcolon <+> pprKind kind
+	ppr_sigx Nothing     = empty
+	ppr_sigx (Just kind) = dcolon <+> pprKind kind
 
     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
-		    tcdFDs = fds, 
+		    tcdFDs  = fds, 
 		    tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
       | null sigs && null ats  -- No "where" part
       = top_matter
@@ -773,14 +765,14 @@ instance (OutputableBndr name) => Outputable (ConDecl name) where
     ppr = pprConDecl
 
 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
-pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
+pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = details
                     , con_res = ResTyH98, con_doc = doc })
-  = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
+  = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
   where
-    ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
-    ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
-    ppr_details con (RecCon fields)  = ppr con <+> pprConDeclFields fields
+    ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
+    ppr_details (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
+    ppr_details (RecCon fields)  = ppr con <+> pprConDeclFields fields
 
 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = PrefixCon arg_tys
@@ -802,7 +794,7 @@ pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyG
 
 %************************************************************************
 %*									*
-\subsection[InstDecl]{An instance declaration
+\subsection[InstDecl]{An instance declaration}
 %*									*
 %************************************************************************
 
@@ -835,7 +827,7 @@ instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats
 
 %************************************************************************
 %*									*
-\subsection[DerivDecl]{A stand-alone instance deriving declaration
+\subsection[DerivDecl]{A stand-alone instance deriving declaration}
 %*									*
 %************************************************************************
 
diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs
index dd24aedb2b..501599993c 100644
--- a/compiler/hsSyn/HsImpExp.lhs
+++ b/compiler/hsSyn/HsImpExp.lhs
@@ -6,12 +6,6 @@
 HsImpExp: Abstract syntax: imports, exports, interfaces
 
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module HsImpExp where
@@ -103,6 +97,7 @@ ieName (IEVar n) 	 = n
 ieName (IEThingAbs  n)   = n
 ieName (IEThingWith n _) = n
 ieName (IEThingAll  n)   = n
+ieName _ = panic "ieName failed pattern match!"
 
 ieNames :: IE a -> [a]
 ieNames (IEVar            n   ) = [n]
@@ -122,8 +117,8 @@ instance (Outputable name) => Outputable (IE name) where
     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
+    ppr (IEModuleContents mod')
+	= ptext (sLit "module") <+> ppr mod'
     ppr (IEGroup n _)           = text ("<IEGroup: " ++ (show n) ++ ">")
     ppr (IEDoc doc)             = ppr doc
     ppr (IEDocNamed string)     = text ("<IEDocNamed: " ++ string ++ ">")
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 826ebda477..88dbfa3664 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -900,8 +900,8 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
 	finsts_mod   = mi_finsts    iface
         hash_env     = mi_hash_fn   iface
         mod_hash     = mi_mod_hash  iface
-        export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
-    		    | otherwise 	    = Nothing
+        export_hash | depend_on_exports = Just (mi_exp_hash iface)
+    		    | otherwise         = Nothing
     
         used_occs = lookupModuleEnv ent_map mod `orElse` []
 
@@ -918,21 +918,21 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
                 Just r  -> r
 
-        depend_on_exports mod = 
-           case lookupModuleEnv direct_imports mod of
-    	        Just _ -> True
-                  -- Even if we used 'import M ()', we have to register a
-                  -- usage on the export list because we are sensitive to
-                  -- changes in orphan instances/rules.
-	    	Nothing -> False
-                  -- In GHC 6.8.x the above line read "True", and in
-                  -- fact it recorded a dependency on *all* the
-                  -- modules underneath in the dependency tree.  This
-                  -- happens to make orphans work right, but is too
-                  -- expensive: it'll read too many interface files.
-                  -- The 'isNothing maybe_iface' check above saved us
-                  -- from generating many of these usages (at least in
-                  -- one-shot mode), but that's even more bogus!
+        depend_on_exports = is_direct_import
+        {- True
+              Even if we used 'import M ()', we have to register a
+              usage on the export list because we are sensitive to
+              changes in orphan instances/rules.
+           False
+              In GHC 6.8.x we always returned true, and in
+              fact it recorded a dependency on *all* the
+              modules underneath in the dependency tree.  This
+              happens to make orphans work right, but is too
+              expensive: it'll read too many interface files.
+              The 'isNothing maybe_iface' check above saved us
+              from generating many of these usages (at least in
+              one-shot mode), but that's even more bogus!
+        -}
 \end{code}
 
 \begin{code}
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index 661dc9afe4..b0c63a4c34 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -38,6 +38,8 @@ lmGlobalReg suf reg
         VanillaReg 4 _ -> wordGlobal $ "R4" ++ suf
         VanillaReg 5 _ -> wordGlobal $ "R5" ++ suf
         VanillaReg 6 _ -> wordGlobal $ "R6" ++ suf
+        VanillaReg 7 _ -> wordGlobal $ "R7" ++ suf
+        VanillaReg 8 _ -> wordGlobal $ "R8" ++ suf
         SpLim          -> wordGlobal $ "SpLim" ++ suf
         FloatReg 1     -> floatGlobal $"F1" ++ suf
         FloatReg 2     -> floatGlobal $"F2" ++ suf
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index e430c6e269..1694aba9b8 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -16,7 +16,6 @@ module DriverMkDepend (
 #include "HsVersions.h"
 
 import qualified GHC
--- import GHC              ( ModSummary(..), GhcMonad )
 import GhcMonad
 import HsSyn            ( ImportDecl(..) )
 import DynFlags
@@ -35,7 +34,6 @@ import FastString
 
 import Exception
 import ErrUtils
--- import MonadUtils       ( liftIO )
 
 import System.Directory
 import System.FilePath
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 61486fc3b6..70d99d40af 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -779,9 +779,9 @@ runPhase (Cpp sf) input_fn dflags0
             src_opts <- io $ getOptionsFromFile dflags0 output_fn
             (dflags2, unhandled_flags, warns)
                 <- io $ parseDynamicNoPackageFlags dflags0 src_opts
+            io $ checkProcessArgsResult unhandled_flags
             unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns
             -- the HsPp pass below will emit warnings
-            io $ checkProcessArgsResult unhandled_flags
 
             setDynFlags dflags2
 
@@ -814,8 +814,8 @@ runPhase (HsPp sf) input_fn dflags
             (dflags1, unhandled_flags, warns)
                 <- io $ parseDynamicNoPackageFlags dflags src_opts
             setDynFlags dflags1
-            io $ handleFlagWarnings dflags1 warns
             io $ checkProcessArgsResult unhandled_flags
+            io $ handleFlagWarnings dflags1 warns
 
             return (Hsc sf, output_fn)
 
@@ -1027,11 +1027,10 @@ runPhase cc_phase input_fn dflags
         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
                               (cmdline_include_paths ++ pkg_include_dirs)
 
-        let md_c_flags = machdepCCOpts dflags
-        gcc_extra_viac_flags <- io $ getExtraViaCOpts dflags
+        let gcc_extra_viac_flags = extraGccViaCFlags dflags
         let pic_c_flags = picCCOpts dflags
 
-        let verb = getVerbFlag dflags
+        let verbFlags = getVerbFlags dflags
 
         -- cc-options are not passed when compiling .hc files.  Our
         -- hc code doesn't not #include any header files anyway, so these
@@ -1092,8 +1091,7 @@ runPhase cc_phase input_fn dflags
                         , SysTools.FileOption "" output_fn
                         ]
                        ++ map SysTools.Option (
-                          md_c_flags
-                       ++ pic_c_flags
+                          pic_c_flags
 
 #if    defined(mingw32_TARGET_OS)
                 -- Stub files generated for foreign exports references the runIO_closure
@@ -1118,7 +1116,8 @@ runPhase cc_phase input_fn dflags
                        ++ (if hcc
                              then gcc_extra_viac_flags ++ more_hcc_opts
                              else [])
-                       ++ [ verb, "-S", "-Wimplicit", cc_opt ]
+                       ++ verbFlags
+                       ++ [ "-S", "-Wimplicit", cc_opt ]
                        ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
 #ifdef darwin_TARGET_OS
                        ++ framework_paths
@@ -1177,7 +1176,6 @@ runPhase As input_fn dflags
         -- might be a hierarchical module.
         io $ createDirectoryHierarchy (takeDirectory output_fn)
 
-        let md_c_flags = machdepCCOpts dflags
         io $ SysTools.runAs dflags
                        (map SysTools.Option as_opts
                        ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
@@ -1195,8 +1193,7 @@ runPhase As input_fn dflags
                           , SysTools.FileOption "" input_fn
                           , SysTools.Option "-o"
                           , SysTools.FileOption "" output_fn
-                          ]
-                       ++ map SysTools.Option md_c_flags)
+                          ])
 
         return (next_phase, output_fn)
 
@@ -1232,7 +1229,6 @@ runPhase SplitAs _input_fn dflags
             split_obj n = split_odir </>
                           takeFileName base_o ++ "__" ++ show n <.> osuf
 
-        let md_c_flags = machdepCCOpts dflags
         let assemble_file n
               = SysTools.runAs dflags
                          (map SysTools.Option as_opts ++
@@ -1250,8 +1246,7 @@ runPhase SplitAs _input_fn dflags
                           , SysTools.Option "-o"
                           , SysTools.FileOption "" (split_obj n)
                           , SysTools.FileOption "" (split_s n)
-                          ]
-                       ++ map SysTools.Option md_c_flags)
+                          ])
 
         io $ mapM_ assemble_file [1..n]
 
@@ -1418,14 +1413,12 @@ mkExtraCObj dflags xs
       oFile <- newTempName dflags "o"
       writeFile cFile xs
       let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId
-          md_c_flags = machdepCCOpts dflags
       SysTools.runCc dflags
                      ([Option        "-c",
                        FileOption "" cFile,
                        Option        "-o",
                        FileOption "" oFile] ++
-                      map (FileOption "-I") (includeDirs rtsDetails) ++
-                      map Option md_c_flags)
+                      map (FileOption "-I") (includeDirs rtsDetails))
       return oFile
 
 mkExtraObjToLinkIntoBinary :: DynFlags -> [PackageId] -> IO FilePath
@@ -1433,7 +1426,10 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
    link_info <- getLinkInfo dflags dep_packages
    mkExtraCObj dflags (showSDoc (vcat [rts_opts_enabled,
                                        extra_rts_opts,
-                                       link_opts link_info]))
+                                       link_opts link_info]
+                                   <> char '\n')) -- final newline, to
+                                                  -- keep gcc happy
+
   where
     mk_rts_opts_enabled val
          = vcat [text "#include \"Rts.h\"",
@@ -1574,7 +1570,7 @@ getHCFilePackages filename =
 
 linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
 linkBinary dflags o_files dep_packages = do
-    let verb = getVerbFlag dflags
+    let verbFlags = getVerbFlags dflags
         output_fn = exeFileName dflags
 
     -- get the full list of packages to link with, by combining the
@@ -1650,14 +1646,13 @@ linkBinary dflags o_files dep_packages = do
 
     rc_objs <- maybeCreateManifest dflags output_fn
 
-    let md_c_flags = machdepCCOpts dflags
     SysTools.runLink dflags (
-                       [ SysTools.Option verb
-                       , SysTools.Option "-o"
-                       , SysTools.FileOption "" output_fn
-                       ]
+                       map SysTools.Option verbFlags
+                      ++ [ SysTools.Option "-o"
+                         , SysTools.FileOption "" output_fn
+                         ]
                       ++ map SysTools.Option (
-                         md_c_flags
+                         []
 
 #ifdef mingw32_TARGET_OS
                       -- Permit the linker to auto link _symbol to _imp_symbol.
@@ -1768,7 +1763,7 @@ maybeCreateManifest dflags exe_filename = do
 
 linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO ()
 linkDynLib dflags o_files dep_packages = do
-    let verb = getVerbFlag dflags
+    let verbFlags = getVerbFlags dflags
     let o_file = outputFile dflags
 
     pkgs <- getPreloadPackagesAnd dflags dep_packages
@@ -1802,7 +1797,6 @@ linkDynLib dflags o_files dep_packages = do
         -- probably _stub.o files
     extra_ld_inputs <- readIORef v_Ld_inputs
 
-    let md_c_flags = machdepCCOpts dflags
     let extra_ld_opts = getOpts dflags opt_l
 
     extraLinkObj <- mkExtraObjToLinkIntoBinary dflags dep_packages
@@ -1813,22 +1807,21 @@ linkDynLib dflags o_files dep_packages = do
     -----------------------------------------------------------------------------
     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
 
-    SysTools.runLink dflags
-         ([ SysTools.Option verb
-          , SysTools.Option "-o"
-          , SysTools.FileOption "" output_fn
-          , SysTools.Option "-shared"
-          ] ++
-          [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
-          | dopt Opt_SharedImplib dflags
-          ]
+    SysTools.runLink dflags (
+            map SysTools.Option verbFlags
+         ++ [ SysTools.Option "-o"
+            , SysTools.FileOption "" output_fn
+            , SysTools.Option "-shared"
+            ] ++
+            [ SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
+            | dopt Opt_SharedImplib dflags
+            ]
          ++ map (SysTools.FileOption "") o_files
          ++ map SysTools.Option (
-            md_c_flags
 
          -- Permit the linker to auto link _symbol to _imp_symbol
          -- This lets us link against DLLs without needing an "import library"
-         ++ ["-Wl,--enable-auto-import"]
+            ["-Wl,--enable-auto-import"]
 
          ++ extra_ld_inputs
          ++ lib_path_opts
@@ -1873,15 +1866,14 @@ linkDynLib dflags o_files dep_packages = do
         Nothing -> do
             pwd <- getCurrentDirectory
             return $ pwd `combine` output_fn
-    SysTools.runLink dflags
-         ([ SysTools.Option verb
-          , SysTools.Option "-dynamiclib"
-          , SysTools.Option "-o"
-          , SysTools.FileOption "" output_fn
-          ]
+    SysTools.runLink dflags (
+            map SysTools.Option verbFlags
+         ++ [ SysTools.Option "-dynamiclib"
+            , SysTools.Option "-o"
+            , SysTools.FileOption "" output_fn
+            ]
          ++ map SysTools.Option (
-            md_c_flags
-         ++ o_files
+            o_files
          ++ [ "-undefined", "dynamic_lookup", "-single_module",
 #if !defined(x86_64_TARGET_ARCH)
               "-Wl,-read_only_relocs,suppress",
@@ -1909,14 +1901,13 @@ linkDynLib dflags o_files dep_packages = do
                              -- non-PIC intra-package-relocations
                              ["-Wl,-Bsymbolic"]
 
-    SysTools.runLink dflags
-         ([ SysTools.Option verb
-          , SysTools.Option "-o"
-          , SysTools.FileOption "" output_fn
-          ]
+    SysTools.runLink dflags (
+            map SysTools.Option verbFlags
+         ++ [ SysTools.Option "-o"
+            , SysTools.FileOption "" output_fn
+            ]
          ++ map SysTools.Option (
-            md_c_flags
-         ++ o_files
+            o_files
          ++ [ "-shared" ]
          ++ bsymbolicFlag
             -- Set the library soname. We use -h rather than -soname as
@@ -1942,14 +1933,11 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
     let include_paths = foldr (\ x xs -> "-I" : x : xs) []
                           (cmdline_include_paths ++ pkg_include_dirs)
 
-    let verb = getVerbFlag dflags
+    let verbFlags = getVerbFlags dflags
 
     let cc_opts
-          | not include_cc_opts = []
-          | otherwise           = (optc ++ md_c_flags)
-                where
-                      optc = getOpts dflags opt_c
-                      md_c_flags = machdepCCOpts dflags
+          | include_cc_opts = getOpts dflags opt_c
+          | otherwise       = []
 
     let cpp_prog args | raw       = SysTools.runCpp dflags args
                       | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
@@ -1962,7 +1950,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
         -- 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]
+    cpp_prog       (   map SysTools.Option verbFlags
                     ++ map SysTools.Option include_paths
                     ++ map SysTools.Option hsSourceCppOpts
                     ++ map SysTools.Option target_defs
@@ -2001,7 +1989,6 @@ joinObjectFiles dflags o_files output_fn = do
                             SysTools.Option ld_x_flag,
                             SysTools.Option "-o",
                             SysTools.FileOption "" output_fn ]
-                         ++ map SysTools.Option md_c_flags
                          ++ args)
 
       ld_x_flag | null cLD_X = ""
@@ -2013,8 +2000,6 @@ joinObjectFiles dflags o_files output_fn = do
       ld_build_id | cLdHasBuildId == "YES"  = "-Wl,--build-id=none"
                   | otherwise               = ""
 
-      md_c_flags = machdepCCOpts dflags
-  
   if cLdIsGNULd == "YES"
      then do
           script <- newTempName dflags "ldscript"
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a38761085c..df75762e21 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -w #-}
--- Temporary, until rtsIsProfiled is fixed
-
 -- |
 -- Dynamic flags
 --
@@ -35,12 +32,21 @@ module DynFlags (
         DPHBackend(..), dphPackageMaybe,
         wayNames,
 
+        Settings(..),
+        ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
+        extraGccViaCFlags, systemPackageConfig,
+        pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
+        pgm_sysman, pgm_windres, pgm_lo, pgm_lc,
+        opt_L, opt_P, opt_F, opt_c, opt_m, opt_a, opt_l,
+        opt_windres, opt_lo, opt_lc,
+
+
         -- ** Manipulating DynFlags
-        defaultDynFlags,                -- DynFlags
+        defaultDynFlags,                -- Settings -> DynFlags
         initDynFlags,                   -- DynFlags -> IO DynFlags
 
         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
-        getVerbFlag,
+        getVerbFlags,
         updOptLevel,
         setTmpDir,
         setPackageName,
@@ -54,14 +60,13 @@ module DynFlags (
         supportedLanguagesAndExtensions,
 
         -- ** DynFlag C compiler options
-        machdepCCOpts, picCCOpts,
+        picCCOpts,
 
         -- * Configuration of the stg-to-stg passes
         StgToDo(..),
         getStgToDo,
 
         -- * Compiler configuration suitable for display to the user
-        Printable(..),
         compilerInfo
 #ifdef GHCI
 -- Only in stage 2 can we be sure that the RTS 
@@ -90,10 +95,14 @@ import Maybes           ( orElse )
 import SrcLoc
 import FastString
 import Outputable
+#ifdef GHCI
 import Foreign.C	( CInt )
+#endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
+#ifdef GHCI
 import System.IO.Unsafe	( unsafePerformIO )
+#endif
 import Data.IORef
 import Control.Monad    ( when )
 
@@ -101,7 +110,7 @@ import Data.Char
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe
+-- import Data.Maybe
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -440,41 +449,13 @@ data DynFlags = DynFlags {
   libraryPaths          :: [String],
   frameworkPaths        :: [String],    -- used on darwin only
   cmdlineFrameworks     :: [String],    -- ditto
-  tmpDir                :: String,      -- no trailing '/'
 
-  ghcUsagePath          :: FilePath,    -- Filled in by SysTools
-  ghciUsagePath         :: FilePath,    -- ditto
   rtsOpts               :: Maybe String,
   rtsOptsEnabled        :: RtsOptsEnabled,
 
   hpcDir                :: String,      -- ^ Path to store the .mix files
 
-  -- 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_windres           :: [String],
-  opt_lo                :: [String], -- LLVM: llvm optimiser
-  opt_lc                :: [String], -- LLVM: llc static compiler
-
-  -- commands for particular phases
-  pgm_L                 :: String,
-  pgm_P                 :: (String,[Option]),
-  pgm_F                 :: String,
-  pgm_c                 :: (String,[Option]),
-  pgm_s                 :: (String,[Option]),
-  pgm_a                 :: (String,[Option]),
-  pgm_l                 :: (String,[Option]),
-  pgm_dll               :: (String,[Option]),
-  pgm_T                 :: String,
-  pgm_sysman            :: String,
-  pgm_windres           :: String,
-  pgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser
-  pgm_lc                :: (String,[Option]), -- LLVM: llc static compiler
+  settings              :: Settings,
 
   --  For ghc -M
   depMakefile           :: FilePath,
@@ -484,8 +465,6 @@ data DynFlags = DynFlags {
 
   --  Package flags
   extraPkgConfs         :: [FilePath],
-  topDir                :: FilePath,    -- filled in by SysTools
-  systemPackageConfig   :: FilePath,    -- ditto
         -- ^ The @-package-conf@ flags given on the command line, in the order
         -- they appeared.
 
@@ -520,6 +499,105 @@ data DynFlags = DynFlags {
   haddockOptions :: Maybe String
  }
 
+data Settings = Settings {
+  sGhcUsagePath          :: FilePath,    -- Filled in by SysTools
+  sGhciUsagePath         :: FilePath,    -- ditto
+  sTopDir                :: FilePath,
+  sTmpDir                :: String,      -- no trailing '/'
+  -- You shouldn't need to look things up in rawSettings directly.
+  -- They should have their own fields instead.
+  sRawSettings           :: [(String, String)],
+  sExtraGccViaCFlags     :: [String],
+  sSystemPackageConfig   :: FilePath,
+  -- commands for particular phases
+  sPgm_L                 :: String,
+  sPgm_P                 :: (String,[Option]),
+  sPgm_F                 :: String,
+  sPgm_c                 :: (String,[Option]),
+  sPgm_s                 :: (String,[Option]),
+  sPgm_a                 :: (String,[Option]),
+  sPgm_l                 :: (String,[Option]),
+  sPgm_dll               :: (String,[Option]),
+  sPgm_T                 :: String,
+  sPgm_sysman            :: String,
+  sPgm_windres           :: String,
+  sPgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser
+  sPgm_lc                :: (String,[Option]), -- LLVM: llc static compiler
+  -- options for particular phases
+  sOpt_L                 :: [String],
+  sOpt_P                 :: [String],
+  sOpt_F                 :: [String],
+  sOpt_c                 :: [String],
+  sOpt_m                 :: [String],
+  sOpt_a                 :: [String],
+  sOpt_l                 :: [String],
+  sOpt_windres           :: [String],
+  sOpt_lo                :: [String], -- LLVM: llvm optimiser
+  sOpt_lc                :: [String]  -- LLVM: llc static compiler
+
+ }
+
+ghcUsagePath          :: DynFlags -> FilePath
+ghcUsagePath dflags = sGhcUsagePath (settings dflags)
+ghciUsagePath         :: DynFlags -> FilePath
+ghciUsagePath dflags = sGhciUsagePath (settings dflags)
+topDir                :: DynFlags -> FilePath
+topDir dflags = sTopDir (settings dflags)
+tmpDir                :: DynFlags -> String
+tmpDir dflags = sTmpDir (settings dflags)
+rawSettings           :: DynFlags -> [(String, String)]
+rawSettings dflags = sRawSettings (settings dflags)
+extraGccViaCFlags     :: DynFlags -> [String]
+extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)
+systemPackageConfig   :: DynFlags -> FilePath
+systemPackageConfig dflags = sSystemPackageConfig (settings dflags)
+pgm_L                 :: DynFlags -> String
+pgm_L dflags = sPgm_L (settings dflags)
+pgm_P                 :: DynFlags -> (String,[Option])
+pgm_P dflags = sPgm_P (settings dflags)
+pgm_F                 :: DynFlags -> String
+pgm_F dflags = sPgm_F (settings dflags)
+pgm_c                 :: DynFlags -> (String,[Option])
+pgm_c dflags = sPgm_c (settings dflags)
+pgm_s                 :: DynFlags -> (String,[Option])
+pgm_s dflags = sPgm_s (settings dflags)
+pgm_a                 :: DynFlags -> (String,[Option])
+pgm_a dflags = sPgm_a (settings dflags)
+pgm_l                 :: DynFlags -> (String,[Option])
+pgm_l dflags = sPgm_l (settings dflags)
+pgm_dll               :: DynFlags -> (String,[Option])
+pgm_dll dflags = sPgm_dll (settings dflags)
+pgm_T                 :: DynFlags -> String
+pgm_T dflags = sPgm_T (settings dflags)
+pgm_sysman            :: DynFlags -> String
+pgm_sysman dflags = sPgm_sysman (settings dflags)
+pgm_windres           :: DynFlags -> String
+pgm_windres dflags = sPgm_windres (settings dflags)
+pgm_lo                :: DynFlags -> (String,[Option])
+pgm_lo dflags = sPgm_lo (settings dflags)
+pgm_lc                :: DynFlags -> (String,[Option])
+pgm_lc dflags = sPgm_lc (settings dflags)
+opt_L                 :: DynFlags -> [String]
+opt_L dflags = sOpt_L (settings dflags)
+opt_P                 :: DynFlags -> [String]
+opt_P dflags = sOpt_P (settings dflags)
+opt_F                 :: DynFlags -> [String]
+opt_F dflags = sOpt_F (settings dflags)
+opt_c                 :: DynFlags -> [String]
+opt_c dflags = sOpt_c (settings dflags)
+opt_m                 :: DynFlags -> [String]
+opt_m dflags = sOpt_m (settings dflags)
+opt_a                 :: DynFlags -> [String]
+opt_a dflags = sOpt_a (settings dflags)
+opt_l                 :: DynFlags -> [String]
+opt_l dflags = sOpt_l (settings dflags)
+opt_windres           :: DynFlags -> [String]
+opt_windres dflags = sOpt_windres (settings dflags)
+opt_lo                :: DynFlags -> [String]
+opt_lo dflags = sOpt_lo (settings dflags)
+opt_lc                :: DynFlags -> [String]
+opt_lc dflags = sOpt_lc (settings dflags)
+
 wayNames :: DynFlags -> [WayName]
 wayNames = map wayName . ways
 
@@ -642,8 +720,8 @@ initDynFlags dflags = do
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
 -- and must be fully initialized by 'GHC.newSession' first.
-defaultDynFlags :: DynFlags
-defaultDynFlags =
+defaultDynFlags :: Settings -> DynFlags
+defaultDynFlags mySettings =
      DynFlags {
         ghcMode                 = CompManager,
         ghcLink                 = LinkBinary,
@@ -693,25 +771,11 @@ defaultDynFlags =
         libraryPaths            = [],
         frameworkPaths          = [],
         cmdlineFrameworks       = [],
-        tmpDir                  = cDEFAULT_TMPDIR,
         rtsOpts                 = Nothing,
         rtsOptsEnabled          = RtsOptsSafeOnly,
 
         hpcDir                  = ".hpc",
 
-        opt_L                   = [],
-        opt_P                   = (if opt_PIC
-                                   then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
-                                   else []),
-        opt_F                   = [],
-        opt_c                   = [],
-        opt_a                   = [],
-        opt_m                   = [],
-        opt_l                   = [],
-        opt_windres             = [],
-        opt_lo                  = [],
-        opt_lc                  = [],
-
         extraPkgConfs           = [],
         packageFlags            = [],
         pkgDatabase             = Nothing,
@@ -720,25 +784,7 @@ defaultDynFlags =
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
         splitInfo               = Nothing,
-        -- initSysTools fills all these in
-        ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
-        ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
-        topDir                  = panic "defaultDynFlags: No topDir",
-        systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
-        pgm_L                   = panic "defaultDynFlags: No pgm_L",
-        pgm_P                   = panic "defaultDynFlags: No pgm_P",
-        pgm_F                   = panic "defaultDynFlags: No pgm_F",
-        pgm_c                   = panic "defaultDynFlags: No pgm_c",
-        pgm_s                   = panic "defaultDynFlags: No pgm_s",
-        pgm_a                   = panic "defaultDynFlags: No pgm_a",
-        pgm_l                   = panic "defaultDynFlags: No pgm_l",
-        pgm_dll                 = panic "defaultDynFlags: No pgm_dll",
-        pgm_T                   = panic "defaultDynFlags: No pgm_T",
-        pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
-        pgm_windres             = panic "defaultDynFlags: No pgm_windres",
-        pgm_lo                  = panic "defaultDynFlags: No pgm_lo",
-        pgm_lc                  = panic "defaultDynFlags: No pgm_lc",
-        -- end of initSysTools values
+        settings                = mySettings,
         -- ghc -M values
         depMakefile       = "Makefile",
         depIncludePkgDeps = False,
@@ -873,10 +919,10 @@ getOpts dflags opts = reverse (opts dflags)
 
 -- | Gets the verbosity flag for the current verbosity level. This is fed to
 -- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
-getVerbFlag :: DynFlags -> String
-getVerbFlag dflags
-  | verbosity dflags >= 3  = "-v"
-  | otherwise =  ""
+getVerbFlags :: DynFlags -> [String]
+getVerbFlags dflags
+  | verbosity dflags >= 4 = ["-v"]
+  | otherwise             = []
 
 setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
          setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
@@ -912,9 +958,9 @@ setDumpPrefixForce f d = d { dumpPrefixForce = 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)}
-addOptl   f d = d{ opt_l   = f : opt_l d}
-addOptP   f d = d{ opt_P   = f : opt_P d}
+setPgmP   f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P   = (pgm, map Option args)})
+addOptl   f = alterSettings (\s -> s { sOpt_l   = f : sOpt_l s})
+addOptP   f = alterSettings (\s -> s { sOpt_P   = f : sOpt_P s})
 
 
 setDepMakefile :: FilePath -> DynFlags -> DynFlags
@@ -1095,30 +1141,30 @@ dynamic_flags = [
 
         ------- Specific phases  --------------------------------------------
     -- need to appear before -pgmL to be parsed as LLVM flags.
-  , Flag "pgmlo"          (hasArg (\f d -> d{ pgm_lo  = (f,[])}))
-  , Flag "pgmlc"          (hasArg (\f d -> d{ pgm_lc  = (f,[])}))
-  , Flag "pgmL"           (hasArg (\f d -> d{ pgm_L   = f}))
+  , Flag "pgmlo"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lo  = (f,[])})))
+  , Flag "pgmlc"          (hasArg (\f -> alterSettings (\s -> s { sPgm_lc  = (f,[])})))
+  , Flag "pgmL"           (hasArg (\f -> alterSettings (\s -> s { sPgm_L   = f})))
   , Flag "pgmP"           (hasArg setPgmP)
-  , Flag "pgmF"           (hasArg (\f d -> d{ pgm_F   = f}))
-  , Flag "pgmc"           (hasArg (\f d -> d{ pgm_c   = (f,[])}))
+  , Flag "pgmF"           (hasArg (\f -> alterSettings (\s -> s { sPgm_F   = f})))
+  , Flag "pgmc"           (hasArg (\f -> alterSettings (\s -> s { sPgm_c   = (f,[])})))
   , Flag "pgmm"           (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
-  , Flag "pgms"           (hasArg (\f d -> d{ pgm_s   = (f,[])}))
-  , Flag "pgma"           (hasArg (\f d -> d{ pgm_a   = (f,[])}))
-  , Flag "pgml"           (hasArg (\f d -> d{ pgm_l   = (f,[])}))
-  , Flag "pgmdll"         (hasArg (\f d -> d{ pgm_dll = (f,[])}))
-  , Flag "pgmwindres"     (hasArg (\f d -> d{ pgm_windres = f}))
+  , Flag "pgms"           (hasArg (\f -> alterSettings (\s -> s { sPgm_s   = (f,[])})))
+  , Flag "pgma"           (hasArg (\f -> alterSettings (\s -> s { sPgm_a   = (f,[])})))
+  , Flag "pgml"           (hasArg (\f -> alterSettings (\s -> s { sPgm_l   = (f,[])})))
+  , Flag "pgmdll"         (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
+  , Flag "pgmwindres"     (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
 
     -- need to appear before -optl/-opta to be parsed as LLVM flags.
-  , Flag "optlo"          (hasArg (\f d -> d{ opt_lo  = f : opt_lo d}))
-  , Flag "optlc"          (hasArg (\f d -> d{ opt_lc  = f : opt_lc d}))
-  , Flag "optL"           (hasArg (\f d -> d{ opt_L   = f : opt_L d}))
+  , Flag "optlo"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lo  = f : sOpt_lo s})))
+  , Flag "optlc"          (hasArg (\f -> alterSettings (\s -> s { sOpt_lc  = f : sOpt_lc s})))
+  , Flag "optL"           (hasArg (\f -> alterSettings (\s -> s { sOpt_L   = f : sOpt_L s})))
   , Flag "optP"           (hasArg addOptP)
-  , Flag "optF"           (hasArg (\f d -> d{ opt_F   = f : opt_F d}))
-  , Flag "optc"           (hasArg (\f d -> d{ opt_c   = f : opt_c d}))
-  , Flag "optm"           (hasArg (\f d -> d{ opt_m   = f : opt_m d}))
-  , Flag "opta"           (hasArg (\f d -> d{ opt_a   = f : opt_a d}))
+  , Flag "optF"           (hasArg (\f -> alterSettings (\s -> s { sOpt_F   = f : sOpt_F s})))
+  , Flag "optc"           (hasArg (\f -> alterSettings (\s -> s { sOpt_c   = f : sOpt_c s})))
+  , Flag "optm"           (hasArg (\f -> alterSettings (\s -> s { sOpt_m   = f : sOpt_m s})))
+  , Flag "opta"           (hasArg (\f -> alterSettings (\s -> s { sOpt_a   = f : sOpt_a s})))
   , Flag "optl"           (hasArg addOptl)
-  , Flag "optwindres"     (hasArg (\f d -> d{ opt_windres = f : opt_windres d}))
+  , Flag "optwindres"     (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
 
   , Flag "split-objs"
          (NoArg (if can_split 
@@ -1317,7 +1363,7 @@ dynamic_flags = [
   , Flag "fcontext-stack"              (intSuffix (\n d -> d{ ctxtStkDepth = n }))
   , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
   , Flag "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
-  , Flag "ffloat-all-lams"             (intSuffix (\n d -> d{ floatLamArgs = Nothing }))
+  , Flag "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
 
         ------ Profiling ----------------------------------------------------
 
@@ -1833,18 +1879,20 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
 
 rtsIsProfiled :: Bool
 rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
+#endif
 
 checkTemplateHaskellOk :: Bool -> DynP ()
-checkTemplateHaskellOk turn_on 
+#ifdef GHCI
+checkTemplateHaskellOk turn_on
   | turn_on && rtsIsProfiled
   = addErr "You can't use Template Haskell with a profiled compiler"
   | otherwise
   = return ()
 #else
--- In stage 1 we don't know that the RTS has rts_isProfiled, 
+-- In stage 1 we don't know that the RTS has rts_isProfiled,
 -- so we simply say "ok".  It doesn't matter because TH isn't
 -- available in stage 1 anyway.
-checkTemplateHaskellOk turn_on = return ()
+checkTemplateHaskellOk _ = return ()
 #endif
 
 {- **********************************************************************
@@ -1901,6 +1949,10 @@ unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
    --      (except for -fno-glasgow-exts, which is treated specially)
 
 --------------------------
+alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
+alterSettings f dflags = dflags { settings = f (settings dflags) }
+
+--------------------------
 setDumpFlag' :: DynFlag -> DynP ()
 setDumpFlag' dump_flag
   = do { setDynFlag dump_flag
@@ -2113,7 +2165,7 @@ splitPathList s = filter notNull (splitUp s)
 -- tmpDir, where we store temporary files.
 
 setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
+setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir })
   -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
   -- seem necessary now --SDM 7/2/2008
 
@@ -2138,46 +2190,14 @@ setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
 -- There are some options that we need to pass to gcc when compiling
 -- Haskell code via C, but are only supported by recent versions of
 -- gcc.  The configure script decides which of these options we need,
--- and puts them in the file "extra-gcc-opts" in $topdir, which is
--- read before each via-C compilation.  The advantage of having these
--- in a separate file is that the file can be created at install-time
--- depending on the available gcc version, and even re-generated  later
--- if gcc is upgraded.
+-- and puts them in the "settings" file in $topdir. The advantage of
+-- having these in a separate file is that the file can be created at
+-- install-time depending on the available gcc version, and even
+-- re-generated later if gcc is upgraded.
 --
 -- The options below are not dependent on the version of gcc, only the
 -- platform.
 
-machdepCCOpts :: DynFlags -> [String] -- flags for all C compilations
-machdepCCOpts dflags = cCcOpts ++ machdepCCOpts'
-
-machdepCCOpts' :: [String] -- flags for all C compilations
-machdepCCOpts'
-#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 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.
-        =  if opt_Static then ["-DDONT_WANT_WIN32_DLL_SUPPORT"] else []
-
-#else
-        = []
-#endif
-
 picCCOpts :: DynFlags -> [String]
 picCCOpts _dflags
 #if darwin_TARGET_OS
@@ -2220,30 +2240,34 @@ can_split = cSupportsSplitObjs == "YES"
 -- -----------------------------------------------------------------------------
 -- Compiler Info
 
-data Printable = String String
-               | FromDynFlags (DynFlags -> String)
-
-compilerInfo :: [(String, Printable)]
-compilerInfo = [("Project name",                String cProjectName),
-                ("Project version",             String cProjectVersion),
-                ("Booter version",              String cBooterVersion),
-                ("Stage",                       String cStage),
-                ("Build platform",              String cBuildPlatformString),
-                ("Host platform",               String cHostPlatformString),
-                ("Target platform",             String cTargetPlatformString),
-                ("Have interpreter",            String cGhcWithInterpreter),
-                ("Object splitting supported",  String cSupportsSplitObjs),
-                ("Have native code generator",  String cGhcWithNativeCodeGen),
-                ("Support SMP",                 String cGhcWithSMP),
-                ("Unregisterised",              String cGhcUnregisterised),
-                ("Tables next to code",         String cGhcEnableTablesNextToCode),
-                ("RTS ways",                    String cGhcRTSWays),
-                ("Leading underscore",          String cLeadingUnderscore),
-                ("Debug on",                    String (show debugIsOn)),
-                ("LibDir",                      FromDynFlags topDir),
-                ("Global Package DB",           FromDynFlags systemPackageConfig),
-                ("C compiler flags",            String (show cCcOpts)),
-                ("Gcc Linker flags",            String (show cGccLinkerOpts)),
-                ("Ld Linker flags",             String (show cLdLinkerOpts))
-               ]
+compilerInfo :: DynFlags -> [(String, String)]
+compilerInfo dflags
+    = -- We always make "Project name" be first to keep parsing in
+      -- other languages simple, i.e. when looking for other fields,
+      -- you don't have to worry whether there is a leading '[' or not
+      ("Project name",                 cProjectName)
+      -- Next come the settings, so anything else can be overridden
+      -- in the settings file (as "lookup" uses the first match for the
+      -- key)
+    : rawSettings dflags
+   ++ [("Project version",             cProjectVersion),
+       ("Booter version",              cBooterVersion),
+       ("Stage",                       cStage),
+       ("Build platform",              cBuildPlatformString),
+       ("Host platform",               cHostPlatformString),
+       ("Target platform",             cTargetPlatformString),
+       ("Have interpreter",            cGhcWithInterpreter),
+       ("Object splitting supported",  cSupportsSplitObjs),
+       ("Have native code generator",  cGhcWithNativeCodeGen),
+       ("Support SMP",                 cGhcWithSMP),
+       ("Unregisterised",              cGhcUnregisterised),
+       ("Tables next to code",         cGhcEnableTablesNextToCode),
+       ("RTS ways",                    cGhcRTSWays),
+       ("Leading underscore",          cLeadingUnderscore),
+       ("Debug on",                    show debugIsOn),
+       ("LibDir",                      topDir dflags),
+       ("Global Package DB",           systemPackageConfig dflags),
+       ("Gcc Linker flags",            show cGccLinkerOpts),
+       ("Ld Linker flags",             show cLdLinkerOpts)
+      ]
 
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index db8887a47a..44ec3ff26b 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -430,8 +430,8 @@ initGhcMonad mb_top_dir = do
 
   liftIO $ StaticFlags.initStaticOpts
 
-  dflags0 <- liftIO $ initDynFlags defaultDynFlags
-  dflags <- liftIO $ initSysTools mb_top_dir dflags0
+  mySettings <- liftIO $ initSysTools mb_top_dir
+  dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings)
   env <- liftIO $ newHscEnv dflags
   setSession env
 
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 0d4143560f..ab658942ac 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1405,17 +1405,14 @@ preprocessFile hsc_env src_fn mb_phase Nothing
 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
   = do
         let dflags = hsc_dflags hsc_env
-	-- case we bypass the preprocessing stage?
-	let 
-	    local_opts = getOptions dflags buf src_fn
-	--
+	let local_opts = getOptions dflags buf src_fn
+
 	(dflags', leftovers, warns)
             <- parseDynamicNoPackageFlags dflags local_opts
         checkProcessArgsResult leftovers
         handleFlagWarnings dflags' warns
 
-	let
-	    needs_preprocessing
+	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
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 70ddd6adb8..36e53a83f9 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -1132,12 +1132,11 @@ hscTcExpr	-- Typecheck an expression (but don't run it)
 hscTcExpr hsc_env expr = runHsc hsc_env $ do
     maybe_stmt <- hscParseStmt expr
     case maybe_stmt of
-      Just (L _ (ExprStmt expr _ _)) ->
-          ioMsgMaybe $ tcRnExpr hsc_env (hsc_IC hsc_env) expr
-      _ -> 
-          liftIO $ throwIO $ mkSrcErr $ unitBag $ 
-              mkPlainErrMsg noSrcSpan
-                            (text "not an expression:" <+> quotes (text expr))
+        Just (L _ (ExprStmt expr _ _)) ->
+            ioMsgMaybe $ tcRnExpr hsc_env (hsc_IC hsc_env) expr
+        _ ->
+            liftIO $ throwIO $ mkSrcErr $ unitBag $ mkPlainErrMsg noSrcSpan
+                (text "not an expression:" <+> quotes (text expr))
 
 -- | Find the kind of a type
 hscKcType
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index b1b5fb1ffa..4d096d213a 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -717,7 +717,7 @@ type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
 -- | 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.
+-- 'ModDetails' are extracted and the ModGuts is discarded.
 data ModGuts
   = ModGuts {
         mg_module    :: !Module,         -- ^ Module being compiled
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 5e265e8599..451f78d24e 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -36,7 +36,7 @@ where
 #include "HsVersions.h"
 
 import PackageConfig	
-import DynFlags		( dopt, DynFlag(..), DynFlags(..), PackageFlag(..), DPHBackend(..) )
+import DynFlags
 import StaticFlags
 import Config		( cProjectVersion )
 import Name		( Name, nameModule_maybe )
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 54f0a92115..5767a52552 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -210,7 +210,6 @@ unregFlags :: [Located String]
 unregFlags = map (mkGeneralLocated "in unregFlags")
    [ "-optc-DNO_REGS"
    , "-optc-DUSE_MINIINTERPRETER"
-   , "-fno-asm-mangling"
    , "-funregisterised" ]
 
 -----------------------------------------------------------------------------
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 049b61fedb..732224b9f9 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -167,7 +167,7 @@ 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
+			-- ToDo: hack alert. We should really parse the arguments
 			-- 	 and announce errors in a more civilised way.
 
 
@@ -192,16 +192,12 @@ opt_IgnoreDotGhci		= lookUp (fsLit "-ignore-dot-ghci")
 
 -- debugging options
 -- | Suppress all that is suppressable in core dumps.
+--   Except for uniques, as some simplifier phases introduce new varibles that
+--   have otherwise identical names.
 opt_SuppressAll :: Bool
 opt_SuppressAll	
 	= lookUp  (fsLit "-dsuppress-all")
 
--- | Suppress unique ids on variables.
-opt_SuppressUniques :: Bool
-opt_SuppressUniques
-	=  lookUp  (fsLit "-dsuppress-all")
-	|| lookUp  (fsLit "-dsuppress-uniques")
-
 -- | Suppress all coercions, them replacing with '...'
 opt_SuppressCoercions :: Bool
 opt_SuppressCoercions
@@ -232,10 +228,16 @@ opt_SuppressTypeSignatures
 	=  lookUp  (fsLit "-dsuppress-all")
 	|| lookUp  (fsLit "-dsuppress-type-signatures")
 
+-- | Suppress unique ids on variables.
+--   Except for uniques, as some simplifier phases introduce new variables that
+--   have otherwise identical names.
+opt_SuppressUniques :: Bool
+opt_SuppressUniques
+	=  lookUp  (fsLit "-dsuppress-uniques")
 
 -- | Display case expressions with a single alternative as strict let bindings
 opt_PprCaseAsLet :: Bool
-opt_PprCaseAsLet		= lookUp   (fsLit "-dppr-case-as-let")
+opt_PprCaseAsLet	= lookUp   (fsLit "-dppr-case-as-let")
 
 -- | Set the maximum width of the dumps
 --   If GHC's command line options are bad then the options parser uses the
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 5c64a34650..97a6514746 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -26,7 +26,6 @@ module SysTools (
         touch,                  -- String -> String -> IO ()
         copy,
         copyWithHeader,
-        getExtraViaCOpts,
 
         -- Temporary-file management
         setTmpDir,
@@ -47,6 +46,7 @@ import ErrUtils
 import Panic
 import Util
 import DynFlags
+import StaticFlags
 import Exception
 
 import Data.IORef
@@ -148,25 +148,47 @@ stuff.
 
 \begin{code}
 initSysTools :: Maybe String    -- Maybe TopDir path (without the '-B' prefix)
-
-             -> DynFlags
-             -> IO DynFlags     -- Set all the mutable variables above, holding
+             -> IO Settings     -- Set all the mutable variables above, holding
                                 --      (a) the system programs
                                 --      (b) the package-config file
                                 --      (c) the GHC usage message
-
-
-initSysTools mbMinusB dflags0
+initSysTools mbMinusB
   = do  { top_dir <- findTopDir mbMinusB
                 -- see [Note topdir]
                 -- NB: top_dir is assumed to be in standard Unix
                 -- format, '/' separated
 
-        ; let installed :: FilePath -> FilePath
+        ; let settingsFile = top_dir </> "settings"
+              installed :: FilePath -> FilePath
               installed file = top_dir </> file
               installed_mingw_bin file = top_dir </> ".." </> "mingw" </> "bin" </> file
               installed_perl_bin file = top_dir </> ".." </> "perl" </> file
 
+        ; settingsStr <- readFile settingsFile
+        ; mySettings <- case maybeReadFuzzy settingsStr of
+                        Just s ->
+                            return s
+                        Nothing ->
+                            pgmError ("Can't parse " ++ show settingsFile)
+        ; let getSetting key = case lookup key mySettings of
+                               Just xs ->
+                                   return xs
+                               Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
+        ; myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
+        -- On Windows, mingw is distributed with GHC,
+        -- so we look in TopDir/../mingw/bin
+        -- It would perhaps be nice to be able to override this
+        -- with the settings file, but it would be a little fiddly
+        -- to make that possible, so for now you can't.
+        ; gcc_prog <- if isWindowsHost then return $ installed_mingw_bin "gcc"
+                                       else getSetting "C compiler command"
+        ; gcc_args_str <- if isWindowsHost then return []
+                                           else getSetting "C compiler flags"
+        ; let gcc_args = map Option (words gcc_args_str)
+        ; perl_path <- if isWindowsHost
+                       then return $ installed_perl_bin "perl"
+                       else getSetting "perl command"
+
         ; let pkgconfig_path = installed "package.conf.d"
               ghc_usage_msg_path  = installed "ghc-usage.txt"
               ghci_usage_msg_path = installed "ghci-usage.txt"
@@ -181,17 +203,8 @@ initSysTools mbMinusB dflags0
               windres_path  = installed_mingw_bin "windres"
 
         ; tmpdir <- getTemporaryDirectory
-        ; let dflags1 = setTmpDir tmpdir dflags0
 
-        -- On Windows, mingw is distributed with GHC,
-        --      so we look in TopDir/../mingw/bin
         ; let
-              gcc_prog
-                | isWindowsHost = installed_mingw_bin "gcc"
-                | otherwise     = cGCC
-              perl_path
-                | isWindowsHost = installed_perl_bin cGHC_PERL
-                | otherwise     = cGHC_PERL
               -- 'touch' is a GHC util for Windows
               touch_path
                 | isWindowsHost = installed cGHC_TOUCHY_PGM
@@ -214,37 +227,57 @@ initSysTools mbMinusB dflags0
         -- 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,
-                           (Option "-E"):(map Option (words cRAWCPP_FLAGS)))
+        ; let cpp_prog  = gcc_prog
+              cpp_args  = Option "-E"
+                        : map Option (words cRAWCPP_FLAGS)
+                       ++ gcc_args
 
         -- Other things being equal, as and ld are simply gcc
         ; let   as_prog  = gcc_prog
+                as_args  = gcc_args
                 ld_prog  = gcc_prog
+                ld_args  = gcc_args
 
         -- figure out llvm location. (TODO: Acutally implement).
         ; let lc_prog = "llc"
               lo_prog = "opt"
 
-        ; return dflags1{
-                        ghcUsagePath = ghc_usage_msg_path,
-                        ghciUsagePath = ghci_usage_msg_path,
-                        topDir  = top_dir,
-                        systemPackageConfig = pkgconfig_path,
-                        pgm_L   = unlit_path,
-                        pgm_P   = cpp_path,
-                        pgm_F   = "",
-                        pgm_c   = (gcc_prog,[]),
-                        pgm_s   = (split_prog,split_args),
-                        pgm_a   = (as_prog,[]),
-                        pgm_l   = (ld_prog,[]),
-                        pgm_dll = (mkdll_prog,mkdll_args),
-                        pgm_T   = touch_path,
-                        pgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan",
-                        pgm_windres = windres_path,
-                        pgm_lo  = (lo_prog,[]),
-                        pgm_lc  = (lc_prog,[])
+        ; return $ Settings {
+                        sTmpDir = normalise tmpdir,
+                        sGhcUsagePath = ghc_usage_msg_path,
+                        sGhciUsagePath = ghci_usage_msg_path,
+                        sTopDir  = top_dir,
+                        sRawSettings = mySettings,
+                        sExtraGccViaCFlags = words myExtraGccViaCFlags,
+                        sSystemPackageConfig = pkgconfig_path,
+                        sPgm_L   = unlit_path,
+                        sPgm_P   = (cpp_prog, cpp_args),
+                        sPgm_F   = "",
+                        sPgm_c   = (gcc_prog, gcc_args),
+                        sPgm_s   = (split_prog,split_args),
+                        sPgm_a   = (as_prog, as_args),
+                        sPgm_l   = (ld_prog, ld_args),
+                        sPgm_dll = (mkdll_prog,mkdll_args),
+                        sPgm_T   = touch_path,
+                        sPgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan",
+                        sPgm_windres = windres_path,
+                        sPgm_lo  = (lo_prog,[]),
+                        sPgm_lc  = (lc_prog,[]),
                         -- Hans: this isn't right in general, but you can
                         -- elaborate it in the same way as the others
+                        sOpt_L       = [],
+                        sOpt_P       = (if opt_PIC
+                                        then -- this list gets reversed
+                                             ["-D__PIC__", "-U __PIC__"]
+                                        else []),
+                        sOpt_F       = [],
+                        sOpt_c       = [],
+                        sOpt_a       = [],
+                        sOpt_m       = [],
+                        sOpt_l       = [],
+                        sOpt_windres = [],
+                        sOpt_lo      = [],
+                        sOpt_lc      = []
                 }
         }
 \end{code}
@@ -448,11 +481,6 @@ copyWithHeader dflags purpose maybe_header from to = do
   hClose hout
   hClose hin
 
-getExtraViaCOpts :: DynFlags -> IO [String]
-getExtraViaCOpts dflags = do
-  f <- readFile (topDir dflags </> "extra-gcc-opts")
-  return (words f)
-
 -- | read the contents of the named section in an ELF object as a
 -- String.
 readElfSection :: DynFlags -> String -> FilePath -> IO (Maybe String)
@@ -527,8 +555,9 @@ newTempName dflags extn
 -- return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet
 getTempDir :: DynFlags -> IO FilePath
-getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
+getTempDir dflags
   = do let ref = dirsToClean dflags
+           tmp_dir = tmpDir dflags
        mapping <- readIORef ref
        case Map.lookup tmp_dir mapping of
            Nothing ->
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 7a38540baa..767dc99f61 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -378,10 +378,15 @@ cmmNativeGen dflags us cmm count
 			, Nothing
 			, mPprStats)
 
+	---- generate jump tables
+	let tabled	=
+		{-# SCC "generateJumpTables" #-}
+		alloced ++ generateJumpTables alloced
+
 	---- shortcut branches
 	let shorted	=
 	 	{-# SCC "shortcutBranches" #-}
-	 	shortcutBranches dflags alloced
+	 	shortcutBranches dflags tabled
 
 	---- sequence blocks
 	let sequenced	=
@@ -609,6 +614,18 @@ makeFarBranches = id
 #endif
 
 -- -----------------------------------------------------------------------------
+-- Generate jump tables
+
+-- Analyzes all native code and generates data sections for all jump
+-- table instructions.
+generateJumpTables
+	:: [NatCmmTop Instr] -> [NatCmmTop Instr]
+generateJumpTables xs = concatMap f xs
+    where f (CmmProc _ _ (ListGraph xs)) = concatMap g xs
+          f _ = []
+          g (BasicBlock _ xs) = catMaybes (map generateJumpTableForInstr xs)
+
+-- -----------------------------------------------------------------------------
 -- Shortcut branches
 
 shortcutBranches 
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 29b9a54d49..c96baddca1 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -15,6 +15,7 @@
 
 module PPC.CodeGen ( 
 	cmmTopCodeGen, 
+	generateJumpTableForInstr,
 	InstrBlock 
 ) 
 
@@ -798,7 +799,7 @@ genJump (CmmLit (CmmLabel lbl))
 genJump tree
   = do
         (target,code) <- getSomeReg tree
-        return (code `snocOL` MTCTR target `snocOL` BCTR [])
+        return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)
 
 
 -- -----------------------------------------------------------------------------
@@ -1126,22 +1127,12 @@ genSwitch expr ids
         dflags <- getDynFlagsNat
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
-        let
-            jumpTable = map jumpTableEntryRel ids
-            
-            jumpTableEntryRel Nothing
-                = CmmStaticLit (CmmInt 0 wordWidth)
-            jumpTableEntryRel (Just blockid)
-                = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel (getUnique blockid)
-
-            code = e_code `appOL` t_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+        let code = e_code `appOL` t_code `appOL` toOL [
                             SLW tmp reg (RIImm (ImmInt 2)),
                             LD II32 tmp (AddrRegReg tableReg tmp),
                             ADD tmp tmp (RIReg tableReg),
                             MTCTR tmp,
-                            BCTR [ id | Just id <- ids ]
+                            BCTR ids (Just lbl)
                     ]
         return code
   | otherwise
@@ -1149,19 +1140,27 @@ genSwitch expr ids
         (reg,e_code) <- getSomeReg expr
         tmp <- getNewRegNat II32
         lbl <- getNewLabelNat
-        let
-            jumpTable = map jumpTableEntry ids
-        
-            code = e_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+        let code = e_code `appOL` toOL [
                             SLW tmp reg (RIImm (ImmInt 2)),
                             ADDIS tmp tmp (HA (ImmCLbl lbl)),
                             LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
                             MTCTR tmp,
-                            BCTR [ id | Just id <- ids ]
+                            BCTR ids (Just lbl)
                     ]
         return code
 
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (BCTR ids (Just lbl)) =
+    let jumpTable
+            | opt_PIC   = map jumpTableEntryRel ids
+            | otherwise = map jumpTableEntry ids
+                where jumpTableEntryRel Nothing
+                        = CmmStaticLit (CmmInt 0 wordWidth)
+                      jumpTableEntryRel (Just blockid)
+                        = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
+                            where blockLabel = mkAsmTempLabel (getUnique blockid)
+    in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable))
+generateJumpTableForInstr _ = Nothing
 
 -- -----------------------------------------------------------------------------
 -- 'condIntReg' and 'condFltReg': condition codes into registers
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 6aeccd3a87..0288f1bf02 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -104,7 +104,7 @@ data Instr
 	| JMP     CLabel          	-- same as branch,
                                         -- but with CLabel instead of block ID
 	| MTCTR	Reg
-	| BCTR    [BlockId]       	-- with list of local destinations
+	| BCTR [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary
 	| BL	CLabel [Reg]		-- with list of argument regs
 	| BCTRL	[Reg]
 	      
@@ -184,7 +184,7 @@ ppc_regUsageOfInstr instr
     BCC	   _ _		-> noUsage
     BCCFAR _ _		-> noUsage
     MTCTR reg		-> usage ([reg],[])
-    BCTR  _		-> noUsage
+    BCTR  _ _		-> noUsage
     BL    _ params	-> usage (params, callClobberedRegs)
     BCTRL params	-> usage (params, callClobberedRegs)
     ADD	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
@@ -257,7 +257,7 @@ ppc_patchRegsOfInstr instr env
     BCC	  cond lbl	-> BCC cond lbl
     BCCFAR cond lbl	-> BCCFAR cond lbl
     MTCTR reg		-> MTCTR (env reg)
-    BCTR  targets	-> BCTR targets
+    BCTR  targets lbl	-> BCTR targets lbl
     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)
@@ -326,7 +326,7 @@ ppc_jumpDestsOfInstr insn
   = case insn of
         BCC _ id        -> [id]
         BCCFAR _ id     -> [id]
-        BCTR targets    -> targets
+        BCTR targets _  -> [id | Just id <- targets]
 	_		-> []
 	
 	
@@ -338,7 +338,7 @@ ppc_patchJumpInstr insn patchF
   = case insn of
         BCC cc id 	-> BCC cc (patchF id)
         BCCFAR cc id 	-> BCCFAR cc (patchF id)
-        BCTR _	 	-> error "Cannot patch BCTR"
+        BCTR ids lbl	-> BCTR (map (fmap patchF) ids) lbl
 	_		-> insn
 
 
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 9fb86c013e..44a6a7ce46 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -545,7 +545,7 @@ pprInstr (MTCTR reg) = hcat [
 	char '\t',
 	pprReg reg
     ]
-pprInstr (BCTR _) = hcat [
+pprInstr (BCTR _ _) = hcat [
 	char '\t',
 	ptext (sLit "bctr")
     ]
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 903082fc26..ef6ae9bc3a 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -190,7 +190,7 @@ joinToTargets_again
 		 _	-> let	instr'	=  patchJumpInstr instr 
 		 				(\bid -> if bid == dest 
 								then mkBlockId fixup_block_id 
-								else dest)
+								else bid) -- no change!
 						
 		 	   in	joinToTargets' block_live (block : new_blocks) block_id instr' dests
 
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index d08d10d437..beb48d6656 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -8,6 +8,7 @@
 
 module SPARC.CodeGen ( 
 	cmmTopCodeGen, 
+	generateJumpTableForInstr,
 	InstrBlock 
 ) 
 
@@ -299,15 +300,11 @@ genSwitch expr ids
 		dst		<- getNewRegNat II32
 
 		label 		<- getNewLabelNat
-		let jumpTable	= map jumpTableEntry ids
 
 		return $ e_code `appOL`
 		 toOL	
-		 	-- the jump table
-			[ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
-
-			-- load base of jump table
-			, SETHI (HI (ImmCLbl label)) base_reg
+			[ -- load base of jump table
+			  SETHI (HI (ImmCLbl label)) base_reg
 			, OR    False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
 			
 			-- the addrs in the table are 32 bits wide..
@@ -315,6 +312,11 @@ genSwitch expr ids
 
 			-- load and jump to the destination
 			, LD 	  II32 (AddrRegReg base_reg offset_reg) dst
-			, JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]
+			, JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
 			, NOP ]
 
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (JMP_TBL _ ids label) =
+	let jumpTable = map jumpTableEntry ids
+	in Just (CmmData ReadOnlyData (CmmDataLabel label : jumpTable))
+generateJumpTableForInstr _ = Nothing
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 79b4629e54..93f4d27444 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -37,6 +37,7 @@ import RegClass
 import Reg
 import Size
 
+import CLabel
 import BlockId
 import OldCmm
 import FastString
@@ -194,7 +195,7 @@ data Instr
 	-- With a tabled jump we know all the possible destinations.
 	-- We also need this info so we can work out what regs are live across the jump.
 	-- 
-	| JMP_TBL	AddrMode [BlockId]
+	| JMP_TBL	AddrMode [Maybe BlockId] CLabel
 
 	| CALL		(Either Imm Reg) Int Bool 	-- target, args, terminal
 
@@ -247,7 +248,7 @@ sparc_regUsageOfInstr instr
     FxTOy   _ _  r1 r2 		-> usage ([r1], 		[r2])
 
     JMP     addr 		-> usage (regAddr addr, [])
-    JMP_TBL addr _      	-> usage (regAddr addr, [])
+    JMP_TBL addr _ _    	-> usage (regAddr addr, [])
 
     CALL  (Left _  )  _ True  	-> noUsage
     CALL  (Left _  )  n False 	-> usage (argRegs n, callClobberedRegs)
@@ -315,7 +316,7 @@ sparc_patchRegsOfInstr instr env = case instr of
     FxTOy s1 s2 r1 r2   	-> FxTOy s1 s2 (env r1) (env r2)
 
     JMP     addr        	-> JMP     (fixAddr addr)
-    JMP_TBL addr ids    	-> JMP_TBL (fixAddr addr) ids
+    JMP_TBL addr ids l  	-> JMP_TBL (fixAddr addr) ids l
 
     CALL  (Left i) n t  	-> CALL (Left i) n t
     CALL  (Right r) n t 	-> CALL (Right (env r)) n t
@@ -345,7 +346,7 @@ sparc_jumpDestsOfInstr insn
   = case insn of
 	BI   _ _ id	-> [id]
 	BF   _ _ id	-> [id]
-	JMP_TBL _ ids	-> ids
+	JMP_TBL _ ids _	-> [id | Just id <- ids]
 	_		-> []
 
 
@@ -354,6 +355,7 @@ sparc_patchJumpInstr insn patchF
   = case insn of
 	BI cc annul id	-> BI cc annul (patchF id)
 	BF cc annul id	-> BF cc annul (patchF id)
+	JMP_TBL n ids l	-> JMP_TBL n (map (fmap patchF) ids) l
 	_		-> insn
 
 
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index a63661f145..0139680dcc 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -543,7 +543,7 @@ pprInstr (BF cond b blockid)
     ]
 
 pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr)
-pprInstr (JMP_TBL op _)  = pprInstr (JMP op)
+pprInstr (JMP_TBL op _ _)  = pprInstr (JMP op)
 
 pprInstr (CALL (Left imm) n _)
   = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 5df8f7777e..a6cc36fcb7 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -20,6 +20,7 @@
 
 module X86.CodeGen ( 
 	cmmTopCodeGen, 
+	generateJumpTableForInstr,
 	InstrBlock 
 ) 
 
@@ -1932,16 +1933,7 @@ genSwitch expr ids
         dflags <- getDynFlagsNat
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
-        let
-            jumpTable = map jumpTableEntryRel ids
-            
-            jumpTableEntryRel Nothing
-                = CmmStaticLit (CmmInt 0 wordWidth)
-            jumpTableEntryRel (Just blockid)
-                = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel (getUnique blockid)
-
-            op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
+        let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg wORD_SIZE) (ImmInt 0))
 
 #if x86_64_TARGET_ARCH
@@ -1954,8 +1946,7 @@ genSwitch expr ids
     
             code = e_code `appOL` t_code `appOL` toOL [
                             ADD (intSize wordWidth) op (OpReg tableReg),
-                            JMP_TBL (OpReg tableReg) [ id | Just id <- ids ],
-                            LDATA Text (CmmDataLabel lbl : jumpTable)
+                            JMP_TBL (OpReg tableReg) ids Text lbl
                     ]
 #else
     -- HACK: On x86_64 binutils<2.17 is only able to generate PC32
@@ -1965,20 +1956,18 @@ genSwitch expr ids
     -- conjunction with the hack in PprMach.hs/pprDataItem once
     -- binutils 2.17 is standard.
             code = e_code `appOL` t_code `appOL` toOL [
-			    LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
 			    MOVSxL II32
 				   (OpAddr (AddrBaseIndex (EABaseReg tableReg)
 							  (EAIndex reg wORD_SIZE) (ImmInt 0)))
 				   (OpReg reg),
 			    ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg),
-			    JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+			    JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
 		   ]
 #endif
 #else
             code = e_code `appOL` t_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
                             ADD (intSize wordWidth) op (OpReg tableReg),
-                            JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+                            JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
                     ]
 #endif
         return code
@@ -1987,15 +1976,28 @@ genSwitch expr ids
         (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 ]
+                    JMP_TBL op ids ReadOnlyData lbl
                  ]
         -- in
         return code
 
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl)
+generateJumpTableForInstr _ = Nothing
+
+createJumpTable ids section lbl
+    = let jumpTable
+            | opt_PIC =
+                  let jumpTableEntryRel Nothing
+                          = CmmStaticLit (CmmInt 0 wordWidth)
+                      jumpTableEntryRel (Just blockid)
+                          = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
+                          where blockLabel = mkAsmTempLabel (getUnique blockid)
+                  in map jumpTableEntryRel ids
+            | otherwise = map jumpTableEntry ids
+      in CmmData section (CmmDataLabel lbl : jumpTable)
 
 -- -----------------------------------------------------------------------------
 -- 'condIntReg' and 'condFltReg': condition codes into registers
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index a96452b9f1..e934a6d4ef 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -289,7 +289,11 @@ data Instr
 	| JMP	      Operand
 	| JXX	      Cond BlockId  -- includes unconditional branches
 	| JXX_GBL     Cond Imm      -- non-local version of JXX
-	| JMP_TBL     Operand [BlockId]  -- table jump
+	-- Table jump
+	| JMP_TBL     Operand   -- Address to jump to
+	              [Maybe BlockId] -- Blocks in the jump table
+	              Section   -- Data section jump table should be put in
+	              CLabel    -- Label of jump table
 	| CALL	      (Either Imm Reg) [Reg]
 
 	-- Other things.
@@ -350,7 +354,7 @@ x86_regUsageOfInstr instr
     JXX    _ _		-> mkRU [] []
     JXX_GBL _ _		-> mkRU [] []
     JMP     op		-> mkRUR (use_R op)
-    JMP_TBL op _        -> mkRUR (use_R op)
+    JMP_TBL op _ _ _    -> mkRUR (use_R op)
     CALL (Left _)  params   -> mkRU params callClobberedRegs
     CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
     CLTD   _		-> mkRU [eax] [edx]
@@ -482,7 +486,7 @@ x86_patchRegsOfInstr instr env
     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
+    JMP_TBL op ids s lbl-> JMP_TBL (patchOp op) ids s lbl
 
     GMOV src dst	-> GMOV (env src) (env dst)
     GLD  sz src dst	-> GLD sz (lookupAddr src) (env dst)
@@ -579,7 +583,7 @@ x86_jumpDestsOfInstr
 x86_jumpDestsOfInstr insn 
   = case insn of
 	JXX _ id	-> [id]
-	JMP_TBL _ ids	-> ids
+	JMP_TBL _ ids _ _ -> [id | Just id <- ids]
 	_		-> []
 
 
@@ -589,7 +593,8 @@ x86_patchJumpInstr
 x86_patchJumpInstr insn patchF
   = case insn of
 	JXX cc id 	-> JXX cc (patchF id)
-	JMP_TBL _ _     -> error "Cannot patch JMP_TBL"
+	JMP_TBL op ids section lbl
+	  -> JMP_TBL op (map (fmap patchF) ids) section lbl
 	_		-> insn
 
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 5fe78e1014..4c3454d43b 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -87,7 +87,17 @@ pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
                     else empty
 #endif
+   $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl)
 
+-- | Output the ELF .size directive.
+pprSizeDecl :: CLabel -> Doc
+#if elf_OBJ_FORMAT
+pprSizeDecl lbl =
+    ptext (sLit "\t.size") <+> pprCLabel_asm lbl
+    <> ptext (sLit ", .-") <> pprCLabel_asm lbl
+#else
+pprSizeDecl _ = empty
+#endif
 
 pprBasicBlock :: NatBasicBlock Instr -> Doc
 pprBasicBlock (BasicBlock blockid instrs) =
@@ -626,7 +636,7 @@ pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
 
 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
 pprInstr (JMP op)          = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op)
-pprInstr (JMP_TBL op _)  = pprInstr (JMP op)
+pprInstr (JMP_TBL op _ _ _)  = pprInstr (JMP op)
 pprInstr (CALL (Left imm) _)    = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
 pprInstr (CALL (Right reg) _)   = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
 
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 5c41d7238d..a2d2276901 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -1856,7 +1856,7 @@ pragState dynflags buf loc = (mkPState dynflags buf loc) {
 mkPState :: DynFlags -> StringBuffer -> SrcLoc -> PState
 mkPState flags buf loc =
   PState {
-      buffer	      = buf,
+      buffer        = buf,
       dflags        = flags,
       messages      = emptyMessages,
       last_loc      = mkSrcSpan loc loc,
@@ -1873,34 +1873,34 @@ mkPState flags buf loc =
       alr_justClosedExplicitLetBlock = False
     }
     where
-      bitmap = genericsBit `setBitIf` xopt Opt_Generics flags
-	       .|. ffiBit            `setBitIf` xopt Opt_ForeignFunctionInterface flags
-	       .|. parrBit           `setBitIf` xopt Opt_ParallelArrays  flags
-	       .|. arrowsBit         `setBitIf` xopt Opt_Arrows          flags
-	       .|. thBit             `setBitIf` xopt Opt_TemplateHaskell flags
-	       .|. qqBit             `setBitIf` xopt Opt_QuasiQuotes	 flags
-	       .|. ipBit             `setBitIf` xopt Opt_ImplicitParams	 flags
-	       .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll  flags
-	       .|. bangPatBit        `setBitIf` xopt Opt_BangPatterns flags
-	       .|. tyFamBit          `setBitIf` xopt Opt_TypeFamilies flags
-	       .|. haddockBit        `setBitIf` dopt Opt_Haddock      flags
-	       .|. magicHashBit      `setBitIf` xopt Opt_MagicHash    flags
-	       .|. kindSigsBit       `setBitIf` xopt Opt_KindSignatures flags
-	       .|. recursiveDoBit    `setBitIf` xopt Opt_RecursiveDo flags
-	       .|. recBit 	     `setBitIf` xopt Opt_DoRec  flags
-	       .|. recBit 	     `setBitIf` xopt Opt_Arrows flags
-	       .|. unicodeSyntaxBit  `setBitIf` xopt Opt_UnicodeSyntax flags
-	       .|. unboxedTuplesBit  `setBitIf` xopt Opt_UnboxedTuples flags
+      bitmap =     genericsBit       `setBitIf` xopt Opt_Generics flags
+               .|. ffiBit            `setBitIf` xopt Opt_ForeignFunctionInterface flags
+               .|. parrBit           `setBitIf` xopt Opt_ParallelArrays  flags
+               .|. arrowsBit         `setBitIf` xopt Opt_Arrows          flags
+               .|. thBit             `setBitIf` xopt Opt_TemplateHaskell flags
+               .|. qqBit             `setBitIf` xopt Opt_QuasiQuotes     flags
+               .|. ipBit             `setBitIf` xopt Opt_ImplicitParams  flags
+               .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll  flags
+               .|. bangPatBit        `setBitIf` xopt Opt_BangPatterns    flags
+               .|. tyFamBit          `setBitIf` xopt Opt_TypeFamilies    flags
+               .|. haddockBit        `setBitIf` dopt Opt_Haddock         flags
+               .|. magicHashBit      `setBitIf` xopt Opt_MagicHash       flags
+               .|. kindSigsBit       `setBitIf` xopt Opt_KindSignatures  flags
+               .|. recursiveDoBit    `setBitIf` xopt Opt_RecursiveDo     flags
+               .|. recBit            `setBitIf` xopt Opt_DoRec           flags
+               .|. recBit            `setBitIf` xopt Opt_Arrows          flags
+               .|. unicodeSyntaxBit  `setBitIf` xopt Opt_UnicodeSyntax   flags
+               .|. unboxedTuplesBit  `setBitIf` xopt Opt_UnboxedTuples   flags
                .|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags
                .|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags
                .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
                .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
-               .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
+               .|. relaxedLayoutBit  `setBitIf` xopt Opt_RelaxedLayout flags
                .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b
-			| otherwise = 0
+                        | otherwise = 0
 
 addWarning :: DynFlag -> SrcSpan -> SDoc -> P ()
 addWarning option srcspan warning
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index b01c6c110d..93cc576a81 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -54,7 +54,7 @@ Well, of course you'd need a lot of rules if you did it
 like that, so we use a BuiltinRule instead, so that we
 can match in any two literal values.  So the rule is really
 more like
-        (Lit 4) +# (Lit y) = Lit (x+#y)
+        (Lit x) +# (Lit y) = Lit (x+#y)
 where the (+#) on the rhs is done at compile time
 
 That is why these rules are built in here.  Other rules
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 7d80db4fcc..49f7a97a61 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1738,9 +1738,19 @@ primtype Any a
 	    but never enters a function value.  
 
 	It's also used to instantiate un-constrained type variables after type
-	checking.  For example
+	checking.  For example, {\tt length} has type
 
-	{\tt length Any []}
+	{\tt length :: forall a. [a] -> Int}
+
+	and the list datacon for the empty list has type
+
+	{\tt [] :: forall a. [a]}
+
+	In order to compose these two terms as {\tt length []} a type
+	application is required, but there is no constraint on the
+	choice.  In this situation GHC uses {\tt Any}:
+
+	{\tt length Any ([] Any)}
 
 	Annoyingly, we sometimes need {\tt Any}s of other kinds, such as {\tt (* -> *)} etc.
 	This is a bit like tuples.   We define a couple of useful ones here,
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 503953d4a0..286e3f2815 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -306,7 +306,10 @@ rnValBindsRHS trim mb_bound_names (ValBindsIn mbinds sigs)
            (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
               where
                 valbind' = ValBindsOut anal_binds sigs'
-                valbind'_dus = usesOnly (hsSigsFVs sigs') `plusDU` anal_dus
+                valbind'_dus = anal_dus `plusDU` usesOnly (hsSigsFVs sigs')
+			       -- Put the sig uses *after* the bindings
+			       -- so that the binders are removed from 
+			       -- the uses in the sigs
        }
 
 rnValBindsRHS _ _ b = pprPanic "rnValBindsRHS" (ppr b)
@@ -699,7 +702,7 @@ renameSig _ (SpecInstSig ty)
 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
 -- so, in the top-level case (when mb_names is Nothing)
 -- we use lookupOccRn.  If there's both an imported and a local 'f'
--- then the SPECIALISE pragma is ambiguous, unlike alll other signatures
+-- then the SPECIALISE pragma is ambiguous, unlike all other signatures
 renameSig mb_names sig@(SpecSig v ty inl)
   = do	{ new_v <- case mb_names of
                      Just {} -> lookupSigOccRn mb_names sig v
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 97f4ab3938..c4ad95a333 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -12,7 +12,7 @@ module RnEnv (
 	lookupLocalDataTcNames, lookupSigOccRn,
 	lookupFixityRn, lookupTyFixityRn, 
 	lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
-	lookupSyntaxName, lookupSyntaxTable, 
+	lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
 	lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
 	getLookupOccRn, addUsedRdrNames,
 
@@ -754,6 +754,17 @@ 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}
+lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
+-- Different to lookupSyntaxName because in the non-rebindable
+-- case we desugar directly rather than calling an existing function
+-- Hence the (Maybe (SyntaxExpr Name)) return type
+lookupIfThenElse 
+  = do { rebind <- xoptM Opt_RebindableSyntax
+       ; if not rebind 
+         then return (Nothing, emptyFVs)
+         else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
+                 ; return (Just (HsVar ite), unitFV ite) } }
+
 lookupSyntaxName :: Name 				-- The standard name
 	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
 lookupSyntaxName std_name
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 9bb955131d..d11249aea9 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -268,13 +268,10 @@ rnExpr (ExprWithTySig expr pty)
 
 rnExpr (HsIf _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
-    ; (b1', fvB1) <- rnLExpr b1
-    ; (b2', fvB2) <- rnLExpr b2
-    ; rebind <- xoptM Opt_RebindableSyntax
-    ; if not rebind
-       then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2])
-       else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse")))
-               ; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }}
+       ; (b1', fvB1) <- rnLExpr b1
+       ; (b2', fvB2) <- rnLExpr b2
+       ; (mb_ite, fvITE) <- lookupIfThenElse
+       ; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
 rnExpr (HsType a)
   = rnHsTypeFVs doc a	`thenM` \ (t, fvT) -> 
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 725baeb04f..18c2dfd7ae 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -1252,4 +1252,4 @@ add_bind _ (ValBindsOut {})     = panic "RdrHsSyn:add_bind"
 add_sig :: LSig a -> HsValBinds a -> HsValBinds a
 add_sig s (ValBindsIn bs sigs) = ValBindsIn bs (s:sigs) 
 add_sig _ (ValBindsOut {})     = panic "RdrHsSyn:add_sig"
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index c527d820c5..6ddcff2b26 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -370,13 +370,21 @@ getCoreToDo dflags
 
     simpl_phase phase names iter
       = CoreDoPasses
-          [ maybe_strictness_before phase
+      $   [ maybe_strictness_before phase
           , CoreDoSimplify iter
                 (base_mode { sm_phase = Phase phase
                            , sm_names = names })
 
-          , maybe_rule_check (Phase phase)
-          ]
+          , maybe_rule_check (Phase phase) ]
+
+          -- Vectorisation can introduce a fair few common sub expressions involving 
+          --  DPH primitives. For example, see the Reverse test from dph-examples.
+          --  We need to eliminate these common sub expressions before their definitions
+          --  are inlined in phase 2. The CSE introduces lots of  v1 = v2 bindings, 
+          --  so we also run simpl_gently to inline them.
+      ++  (if dopt Opt_Vectorise dflags && phase == 3
+	    then [CoreCSE, simpl_gently]
+	    else [])
 
     vectorisation
       = runWhen (dopt Opt_Vectorise dflags) $
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 4020a765b7..3063cf4e02 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1259,10 +1259,10 @@ completeCall env var cont
       | not (dopt Opt_D_dump_inlinings dflags) = stuff
       | not (dopt Opt_D_verbose_core2core dflags) 
       = if isExternalName (idName var) then 
-      	  pprTrace "Inlining done:" (ppr var) stuff
+      	  pprDefiniteTrace "Inlining done:" (ppr var) stuff
         else stuff
       | otherwise
-      = pprTrace ("Inlining done: " ++ showSDoc (ppr var))
+      = pprDefiniteTrace ("Inlining done: " ++ showSDoc (ppr var))
            (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding),
                   text "Cont:  " <+> ppr cont])
            stuff
@@ -1421,10 +1421,10 @@ tryRules env rules fn args call_cont
       , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff
 
       | not (dopt Opt_D_dump_rule_rewrites dflags)
-      = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff
+      = pprDefiniteTrace "Rule fired:" (ftext (ru_name rule)) stuff
 
       | otherwise
-      = pprTrace "Rule fired"
+      = pprDefiniteTrace "Rule fired"
            (vcat [text "Rule:" <+> ftext (ru_name rule),
            	  text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)),
            	  text "After: " <+> pprCoreExpr rule_rhs,
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 3a30f9b5a1..8462403813 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -25,7 +25,6 @@ import TcHsType
 import TcPat
 import TcMType
 import TcType
-import RnBinds( misplacedSigErr )
 import Coercion
 import TysPrim
 import Id
@@ -44,7 +43,6 @@ import BasicTypes
 import Outputable
 import FastString
 
-import Data.List( partition )
 import Control.Monad
 
 #include "HsVersions.h"
@@ -559,24 +557,16 @@ tcSpec _ prag = pprPanic "tcSpec" (ppr prag)
 tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
 tcImpPrags prags
   = do { this_mod <- getModule
-       ; let is_imp prag 
-               = case sigName prag of
-                   Nothing   -> False
-                   Just name -> not (nameIsLocalOrFrom this_mod name)
-             (spec_prags, others) = partition isSpecLSig $
-	     		  	    filter is_imp prags
-       ; mapM_ misplacedSigErr others 
-       -- Messy that this misplaced-sig error comes here
-       -- but the others come from the renamer
-       ; mapAndRecoverM (wrapLocM tcImpSpec) spec_prags }
-
-tcImpSpec :: Sig Name -> TcM TcSpecPrag
-tcImpSpec prag@(SpecSig (L _ name) _ _)
+       ; mapAndRecoverM (wrapLocM tcImpSpec) 
+         [L loc (name,prag) | (L loc prag@(SpecSig (L _ name) _ _)) <- prags
+                            , not (nameIsLocalOrFrom this_mod name) ] }
+
+tcImpSpec :: (Name, Sig Name) -> TcM TcSpecPrag
+tcImpSpec (name, prag)
  = do { id <- tcLookupId name
       ; checkTc (isAnyInlinePragma (idInlinePragma id))
                 (impSpecErr name)
       ; tcSpec id prag }
-tcImpSpec p = pprPanic "tcImpSpec" (ppr p)
 
 impSpecErr :: Name -> SDoc
 impSpecErr name
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 195eb994b6..72b99c5f70 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1282,7 +1282,7 @@ inferInstanceContexts oflag infer_specs
     gen_soln (DS { ds_loc = loc, ds_orig = orig, ds_tvs = tyvars 
 		 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })
       = setSrcSpan loc	$
-	addErrCtxt (derivInstCtxt clas inst_tys) $ 
+	addErrCtxt (derivInstCtxt the_pred) $ 
 	do {      -- 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
@@ -1297,7 +1297,7 @@ inferInstanceContexts oflag infer_specs
                                      , not (tyVarsOfPred pred `subVarSet` tv_set)]
 	   ; mapM_ (addErrTc . badDerivedPred) weird_preds	
 
-           ; theta <- simplifyDeriv orig tyvars deriv_rhs
+           ; theta <- simplifyDeriv orig the_pred tyvars deriv_rhs
 	   	-- checkValidInstance tyvars theta clas inst_tys
 		-- Not necessary; see Note [Exotic derived instance contexts]
 		-- 		  in TcSimplify
@@ -1307,6 +1307,8 @@ inferInstanceContexts oflag infer_specs
 		-- Hence no need to call:
 		--   checkValidInstance tyvars theta clas inst_tys
 	   ; return (sortLe (<=) theta) }	-- Canonicalise before returning the solution
+      where
+        the_pred = mkClassPred clas inst_tys
 
 ------------------------------------------------------------------
 mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
@@ -1509,9 +1511,9 @@ standaloneCtxt :: LHsType Name -> SDoc
 standaloneCtxt ty = hang (ptext (sLit "In the stand-alone deriving instance for")) 
 		       2 (quotes (ppr ty))
 
-derivInstCtxt :: Class -> [Type] -> Message
-derivInstCtxt clas inst_tys
-  = ptext (sLit "When deriving the instance for") <+> parens (pprClassPred clas inst_tys)
+derivInstCtxt :: PredType -> Message
+derivInstCtxt pred
+  = ptext (sLit "When deriving the instance for") <+> parens (ppr pred)
 
 badDerivedPred :: PredType -> Message
 badDerivedPred pred
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 9cbd47bcd8..0d0a9f8e08 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -15,6 +15,7 @@ import TcMType
 import TcSMonad
 import TcType
 import TypeRep
+import Type( isTyVarTy )
 import Inst
 import InstEnv
 import TyCon
@@ -318,15 +319,10 @@ reportEqErr ctxt ty1 ty2
 reportTyVarEqErr :: ReportErrCtxt -> TcTyVar -> TcType -> TcM ()
 -- tv1 and ty2 are already tidied
 reportTyVarEqErr ctxt tv1 ty2
-  | not is_meta1
-  , Just tv2 <- tcGetTyVar_maybe ty2
-  , isMetaTyVar tv2
-  = -- sk ~ alpha: swap
-    reportTyVarEqErr ctxt tv2 ty1
-
-  | (not is_meta1)
-  = -- sk ~ ty, where ty isn't a meta-tyvar: mis-match
-    addErrorReport (addExtraInfo ctxt ty1 ty2)
+  |  isSkolemTyVar tv1 	  -- ty2 won't be a meta-tyvar, or else the thing would
+     		   	  -- be oriented the other way round; see TcCanonical.reOrient
+  || isSigTyVar tv1 && not (isTyVarTy ty2)
+  = addErrorReport (addExtraInfo ctxt ty1 ty2)
                    (misMatchOrCND ctxt ty1 ty2)
 
   -- So tv is a meta tyvar, and presumably it is
@@ -374,21 +370,26 @@ reportTyVarEqErr ctxt tv1 ty2
                          , ptext (sLit "bound at") <+> ppr (ctLocOrigin implic_loc)]
        ; addErrorReport (addExtraInfo ctxt ty1 ty2) (msg $$ nest 2 extra) }
 
-  | otherwise      -- This can happen, by a recursive decomposition of frozen
-                   -- occurs check constraints
-                   -- Example: alpha ~ T Int alpha has frozen.
-                   --          Then alpha gets unified to T beta gamma
-                   -- So now we have  T beta gamma ~ T Int (T beta gamma)
-                   -- Decompose to (beta ~ Int, gamma ~ T beta gamma)
-                   -- The (gamma ~ T beta gamma) is the occurs check, but
-                   -- the (beta ~ Int) isn't an error at all.  So return ()
-  = return ()
-
+  | otherwise
+  = pprTrace "reportTyVarEqErr" (ppr tv1 $$ ppr ty2 $$ ppr (cec_encl ctxt)) $
+    return () 
+    	-- I don't think this should happen, and if it does I want to know
+	-- Trac #5130 happened because an actual type error was not
+	-- reported at all!  So not reporting is pretty dangerous.
+	-- 
+	-- OLD, OUT OF DATE COMMENT
+        -- This can happen, by a recursive decomposition of frozen
+        -- occurs check constraints
+        -- Example: alpha ~ T Int alpha has frozen.
+        --          Then alpha gets unified to T beta gamma
+        -- So now we have  T beta gamma ~ T Int (T beta gamma)
+        -- Decompose to (beta ~ Int, gamma ~ T beta gamma)
+        -- The (gamma ~ T beta gamma) is the occurs check, but
+        -- the (beta ~ Int) isn't an error at all.  So return ()
   where         
-    is_meta1 = isMetaTyVar tv1
-    k1 	     = tyVarKind tv1
-    k2 	     = typeKind ty2
-    ty1      = mkTyVarTy tv1
+    k1 	= tyVarKind tv1
+    k2 	= typeKind ty2
+    ty1 = mkTyVarTy tv1
 
 mkTyFunInfoMsg :: TcType -> TcType -> SDoc
 -- See Note [Non-injective type functions]
@@ -456,12 +457,22 @@ typeExtraInfoMsg :: [Implication] -> Type -> SDoc
 -- Shows a bit of extra info about skolem constants
 typeExtraInfoMsg implics ty
   | Just tv <- tcGetTyVar_maybe ty
-  , isTcTyVar tv
-  , isSkolemTyVar tv
- = pprSkolTvBinding implics tv
-  where
-typeExtraInfoMsg _ _ = empty            -- Normal case
-
+  , isTcTyVar tv, isSkolemTyVar tv
+  , let pp_tv = quotes (ppr tv)
+ = case tcTyVarDetails tv of
+    SkolemTv {}   -> pp_tv <+> ppr_skol (getSkolemInfo implics tv) (getSrcLoc tv)
+    FlatSkol {}   -> pp_tv <+> ptext (sLit "is a flattening type variable")
+    RuntimeUnk {} -> pp_tv <+> ptext (sLit "is an interactive-debugger skolem")
+    MetaTv {}     -> empty
+
+ | otherwise             -- Normal case
+ = empty
+
+ where
+   ppr_skol UnkSkol _   = ptext (sLit "is an unknown type variable")  -- Unhelpful
+   ppr_skol info    loc = sep [ptext (sLit "is a rigid type variable bound by"),
+                               sep [ppr info, ptext (sLit "at") <+> ppr loc]]
+ 
 --------------------
 unifyCtxt :: EqOrigin -> TidyEnv -> TcM (TidyEnv, SDoc)
 unifyCtxt (UnifyOrigin { uo_actual = act_ty, uo_expected = exp_ty }) tidy_env
@@ -657,7 +668,6 @@ mkMonomorphismMsg :: ReportErrCtxt -> [TcTyVar] -> TcM (TidyEnv, SDoc)
 -- ASSUMPTION: the Insts are fully zonked
 mkMonomorphismMsg ctxt inst_tvs
   = do	{ dflags <- getDOpts
-        ; traceTc "Mono" (vcat (map (pprSkolTvBinding (cec_encl ctxt)) inst_tvs))
         ; (tidy_env, docs) <- findGlobals ctxt (mkVarSet inst_tvs)
 	; return (tidy_env, mk_msg dflags docs) }
   where
@@ -683,28 +693,6 @@ monomorphism_fix dflags
            else empty]	-- Only suggest adding "-XNoMonomorphismRestriction"
 			-- if it is not already set!
 
-
-pprSkolTvBinding :: [Implication] -> TcTyVar -> SDoc
--- Print info about the binding of a skolem tyvar, 
--- or nothing if we don't have anything useful to say
-pprSkolTvBinding implics tv
-  | isTcTyVar tv = quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
-  | otherwise    = quotes (ppr tv) <+> ppr_skol    (getSkolemInfo implics tv)
-  where
-    ppr_details (SkolemTv {})        = ppr_skol (getSkolemInfo implics tv)
-    ppr_details (FlatSkol {})        = ptext (sLit "is a flattening type variable")
-    ppr_details (RuntimeUnk {})      = ptext (sLit "is an interactive-debugger skolem")
-    ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for")
-                                       <+> quotes (ppr n)
-    ppr_details (MetaTv _ _)         = ptext (sLit "is a meta type variable")
-
-
-    ppr_skol UnkSkol        = ptext (sLit "is an unknown type variable")        -- Unhelpful
-    ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
-    ppr_skol info           = sep [ptext (sLit "is a rigid type variable bound by"),
-                                   sep [ppr info,
-                                        ptext (sLit "at") <+> ppr (getSrcLoc tv)]]
- 
 getSkolemInfo :: [Implication] -> TcTyVar -> SkolemInfo
 getSkolemInfo [] tv
   = WARN( True, ptext (sLit "No skolem info:") <+> ppr tv )
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 73fd449d32..8f53d6e7b8 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -12,11 +12,11 @@ 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
+module TcForeign
+        (
+          tcForeignImports
         , tcForeignExports
-	) where
+        ) where
 
 #include "HsVersions.h"
 
@@ -43,18 +43,18 @@ import FastString
 -- Defines a binding
 isForeignImport :: LForeignDecl name -> Bool
 isForeignImport (L _ (ForeignImport _ _ _)) = True
-isForeignImport _			      = False
+isForeignImport _                           = False
 
 -- Exports a binding
 isForeignExport :: LForeignDecl name -> Bool
 isForeignExport (L _ (ForeignExport _ _ _)) = True
-isForeignExport _	  	              = False
+isForeignExport _                           = False
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Imports}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -64,22 +64,22 @@ tcForeignImports decls
 
 tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
 tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl)
- = addErrCtxt (foreignDeclCtxt fo)  $ 
-   do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_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).
-   
-      ; imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
-         -- Can't use sig_ty here because sig_ty :: Type and 
-	 -- we need HsType Id hence the undefined
-      ; return (id, ForeignImport (L loc id) undefined imp_decl') }
+  = addErrCtxt (foreignDeclCtxt fo)  $
+    do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_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).
+
+       ; imp_decl' <- tcCheckFIType sig_ty arg_tys res_ty imp_decl
+          -- Can't use sig_ty here because sig_ty :: Type and
+          -- we need HsType Id hence the undefined
+       ; return (id, ForeignImport (L loc id) undefined imp_decl') }
 tcFImport d = pprPanic "tcFImport" (ppr d)
 \end{code}
 
@@ -93,15 +93,15 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ (CLabel _))
     do { checkCg checkCOrAsmOrLlvmOrInterp
        ; checkSafety safety
        ; check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty)
-       ; return idecl }	     -- NB check res_ty not sig_ty!
-       	 	      	     --    In case sig_ty is (forall a. ForeignPtr a)
+       ; return idecl }      -- NB check res_ty not sig_ty!
+                             --    In case sig_ty is (forall a. ForeignPtr a)
 
 tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ CWrapper) = do
-   	-- 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.
+        -- 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 checkCOrAsmOrLlvmOrInterp
     checkCConv cconv
     checkSafety safety
@@ -174,14 +174,14 @@ checkMissingAmpersand dflags arg_tys res_ty
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Exports}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-tcForeignExports :: [LForeignDecl Name] 
-    		 -> TcM (LHsBinds TcId, [LForeignDecl TcId])
+tcForeignExports :: [LForeignDecl Name]
+                 -> TcM (LHsBinds TcId, [LForeignDecl TcId])
 tcForeignExports decls
   = foldlM combine (emptyLHsBinds, []) (filter isForeignExport decls)
   where
@@ -190,25 +190,25 @@ tcForeignExports decls
        return (b `consBag` binds, f:fs)
 
 tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id)
-tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) =
-   addErrCtxt (foreignDeclCtxt fo)      $ do
+tcFExport fo@(ForeignExport (L loc nm) hs_ty spec)
+  = addErrCtxt (foreignDeclCtxt fo) $ do
 
-   sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
-   rhs <- tcPolyExpr (nlHsVar nm) sig_ty
+    sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+    rhs <- tcPolyExpr (nlHsVar nm) sig_ty
 
-   tcCheckFEType sig_ty spec
+    tcCheckFEType sig_ty spec
 
-	  -- 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).
+           -- 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).
 
 
-   -- We need to give a name to the new top-level binding that
-   -- is *stable* (i.e. the compiler won't change it later),
-   -- because this name will be referred to by the C code stub.
-   id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
-   return (mkVarBind id rhs, ForeignExport (L loc id) undefined spec)
+    -- We need to give a name to the new top-level binding that
+    -- is *stable* (i.e. the compiler won't change it later),
+    -- because this name will be referred to by the C code stub.
+    id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
+    return (mkVarBind id rhs, ForeignExport (L loc id) undefined spec)
 tcFExport d = pprPanic "tcFExport" (ppr d)
 \end{code}
 
@@ -232,9 +232,9 @@ tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Miscellaneous}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -246,7 +246,7 @@ checkForeignArgs pred tys
     go ty = check (pred ty) (illegalForeignTyErr argument ty)
 
 ------------ Checking result types for foreign calls ----------------------
--- Check that the type has the form 
+-- Check that the type has the form
 --    (IO t) or (t) , and that t satisfies the given predicate.
 --
 checkForeignRes :: Bool -> (Type -> Bool) -> Type -> TcM ()
@@ -256,14 +256,14 @@ nonIOok  = True
 mustBeIO = False
 
 checkForeignRes non_io_result_ok pred_res_ty ty
-	-- (IO t) is ok, and so is any newtype wrapping thereof
+        -- (IO t) is ok, and so is any newtype wrapping thereof
   | Just (_, res_ty, _) <- tcSplitIOType_maybe ty,
     pred_res_ty res_ty
   = return ()
- 
+
   | otherwise
-  = check (non_io_result_ok && pred_res_ty ty) 
-	  (illegalForeignTyErr result ty)
+  = check (non_io_result_ok && pred_res_ty ty)
+          (illegalForeignTyErr result ty)
 \end{code}
 
 \begin{code}
@@ -272,7 +272,7 @@ checkCOrAsmOrLlvm HscC    = Nothing
 checkCOrAsmOrLlvm HscAsm  = Nothing
 checkCOrAsmOrLlvm HscLlvm = Nothing
 checkCOrAsmOrLlvm _
-   = Just (text "requires via-C, llvm (-fllvm) or native code generation (-fvia-C)")
+  = Just (text "requires via-C, llvm (-fllvm) or native code generation (-fvia-C)")
 
 checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc
 checkCOrAsmOrLlvmOrInterp HscC           = Nothing
@@ -280,7 +280,7 @@ checkCOrAsmOrLlvmOrInterp HscAsm         = Nothing
 checkCOrAsmOrLlvmOrInterp HscLlvm        = Nothing
 checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing
 checkCOrAsmOrLlvmOrInterp _
-   = Just (text "requires interpreted, C, Llvm or native code generation")
+  = Just (text "requires interpreted, C, Llvm or native code generation")
 
 checkCOrAsmOrLlvmOrDotNetOrInterp :: HscTarget -> Maybe SDoc
 checkCOrAsmOrLlvmOrDotNetOrInterp HscC           = Nothing
@@ -288,33 +288,33 @@ checkCOrAsmOrLlvmOrDotNetOrInterp HscAsm         = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp HscLlvm        = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp HscInterpreted = Nothing
 checkCOrAsmOrLlvmOrDotNetOrInterp _
-   = Just (text "requires interpreted, C, Llvm or native code generation")
+  = Just (text "requires interpreted, C, Llvm or native code generation")
 
 checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
 checkCg check = do
-   dflags <- getDOpts
-   let target = hscTarget dflags
-   case target of
-     HscNothing -> return ()
-     _ ->
-       case check target of
-	 Nothing  -> return ()
-	 Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
+    dflags <- getDOpts
+    let target = hscTarget dflags
+    case target of
+      HscNothing -> return ()
+      _ ->
+        case check target of
+          Nothing  -> return ()
+          Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
 \end{code}
-			   
+
 Calling conventions
 
 \begin{code}
 checkCConv :: CCallConv -> TcM ()
-checkCConv CCallConv  = return ()
+checkCConv CCallConv    = return ()
 #if i386_TARGET_ARCH
-checkCConv StdCallConv = return ()
+checkCConv StdCallConv  = return ()
 #else
 -- This is a warning, not an error. see #3336
-checkCConv StdCallConv = addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform,"$$ text "treating as ccall")
+checkCConv StdCallConv  = addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
 #endif
 checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
-checkCConv CmmCallConv = panic "checkCConv CmmCallConv"
+checkCConv CmmCallConv  = panic "checkCConv CmmCallConv"
 \end{code}
 
 Deprecated "threadsafe" calls
@@ -329,12 +329,12 @@ Warnings
 
 \begin{code}
 check :: Bool -> Message -> TcM ()
-check True _	   = return ()
+check True _       = return ()
 check _    the_err = addErrTc the_err
 
 illegalForeignTyErr :: SDoc -> Type -> SDoc
 illegalForeignTyErr arg_or_res ty
-  = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res, 
+  = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res,
                 ptext (sLit "type in foreign declaration:")])
        2 (hsep [ppr ty])
 
@@ -344,12 +344,11 @@ argument = text "argument"
 result   = text "result"
 
 badCName :: CLabelString -> Message
-badCName target 
-   = sep [quotes (ppr target) <+> ptext (sLit "is not a valid C identifier")]
+badCName target
+  = sep [quotes (ppr target) <+> ptext (sLit "is not a valid C identifier")]
 
 foreignDeclCtxt :: ForeignDecl Name -> SDoc
 foreignDeclCtxt fo
   = hang (ptext (sLit "When checking declaration:"))
        2 (ppr fo)
 \end{code}
-
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 272199999b..b76b75cb7f 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -892,15 +892,15 @@ gen_Read_binds get_fixity loc tycon
     read_nullary_cons 
       = case nullary_cons of
     	    []    -> []
-    	    [con] -> [nlHsDo DoExpr [bindLex (match_con con)] (result_expr con [])]
+    	    [con] -> [nlHsDo DoExpr (match_con con) (result_expr con [])]
             _     -> [nlHsApp (nlHsVar choose_RDR) 
     		   	      (nlList (map mk_pair nullary_cons))]
         -- NB For operators the parens around (:=:) are matched by the
 	-- enclosing "parens" call, so here we must match the naked
 	-- data_con_str con
 
-    match_con con | isSym con_str = symbol_pat con_str
-                  | otherwise     = ident_pat  con_str
+    match_con con | isSym con_str = [symbol_pat con_str]
+                  | otherwise     = ident_h_pat  con_str
                   where
                     con_str = data_con_str con
 	-- For nullary constructors we must match Ident s for normal constrs
@@ -924,12 +924,12 @@ gen_Read_binds get_fixity loc tycon
 	prefix_parser = mk_parser prefix_prec prefix_stmts body
 
 	read_prefix_con
-	    | isSym con_str = [read_punc "(", bindLex (symbol_pat con_str), read_punc ")"]
-	    | otherwise     = [bindLex (ident_pat con_str)]
+	    | isSym con_str = [read_punc "(", symbol_pat con_str, read_punc ")"]
+	    | otherwise     = ident_h_pat con_str
      	 
 	read_infix_con
-	    | isSym con_str = [bindLex (symbol_pat con_str)]
-	    | otherwise     = [read_punc "`", bindLex (ident_pat con_str), read_punc "`"]
+	    | isSym con_str = [symbol_pat con_str]
+	    | otherwise     = [read_punc "`"] ++ ident_h_pat con_str ++ [read_punc "`"]
 
        	prefix_stmts		-- T a b c
        	  = read_prefix_con ++ read_args
@@ -971,8 +971,15 @@ gen_Read_binds get_fixity loc tycon
     result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as)		-- return (con 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 ">>"
+
+    -- For constructors and field labels ending in '#', we hackily
+    -- let the lexer generate two tokens, and look for both in sequence
+    -- Thus [Ident "I"; Symbol "#"].  See Trac #5041
+    ident_h_pat s | Just (ss, '#') <- snocView s = [ ident_pat ss, symbol_pat "#" ]
+                  | otherwise                    = [ ident_pat s ]
+      		      		   
+    ident_pat  s = bindLex $ nlConPat ident_RDR  [nlLitPat (mkHsString s)]  -- Ident "foo" <- lexP
+    symbol_pat s = bindLex $ nlConPat symbol_RDR [nlLitPat (mkHsString s)]  -- Symbol ">>" <- lexP
     
     data_con_str con = occNameString (getOccName con)
     
@@ -990,11 +997,9 @@ gen_Read_binds get_fixity loc tycon
 	-- or	(#) = 4
 	-- Note the parens!
     read_lbl lbl | isSym lbl_str 
-		 = [read_punc "(", 
-		    bindLex (symbol_pat lbl_str),
-		    read_punc ")"]
+		 = [read_punc "(", symbol_pat lbl_str, read_punc ")"]
 		 | otherwise
-		 = [bindLex (ident_pat lbl_str)]
+		 = ident_h_pat lbl_str
 		 where	
 		   lbl_str = occNameString (getOccName lbl) 
 \end{code}
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index f789e6f655..d17974675c 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -1046,9 +1046,16 @@ doInteractWithInert (CIPCan { cc_id = id1, cc_flavor = ifl, cc_ip_nm = nm1, cc_i
   | nm1 == nm2
   =  	-- See Note [When improvement happens]
     do { co_var <- newCoVar ty2 ty1 -- See Note [Efficient Orientation]
-       ; let flav = Wanted (combineCtLoc ifl wfl) 
-       ; cans <- mkCanonical flav co_var 
-       ; mkIRContinue "IP/IP fundep" workItem KeepInert cans }
+       ; let flav = Wanted (combineCtLoc ifl wfl)
+       ; cans <- mkCanonical flav co_var
+       ; case wfl of
+           Given   {} -> pprPanic "Unexpected given IP" (ppr workItem)
+           Derived {} -> pprPanic "Unexpected derived IP" (ppr workItem)
+           Wanted  {} ->
+               do { setIPBind (cc_id workItem) $
+                    EvCast id1 (mkSymCoercion (mkCoVarCoercion co_var))
+                  ; mkIRStopK "IP/IP interaction (solved)" cans }
+       }
 
 -- Never rewrite a given with a wanted equality, and a type function
 -- equality can never rewrite an equality. We rewrite LHS *and* RHS 
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 88493bf1ab..531ee44ca5 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -33,8 +33,8 @@ module TcMType (
 
   --------------------------------
   -- Instantiation
-  tcInstTyVar, tcInstTyVars, tcInstSigTyVars,
-  tcInstType, instMetaTyVar,
+  tcInstTyVars, tcInstSigTyVars,
+  tcInstType, 
   tcInstSkolTyVars, tcInstSuperSkolTyVars, tcInstSkolTyVar, tcInstSkolType,
   tcSkolDFunType, tcSuperSkolTyVars,
 
@@ -255,8 +255,17 @@ tcInstSkolType ty = tcInstType tcInstSkolTyVars ty
 tcInstSigTyVars :: [TyVar] -> TcM [TcTyVar]
 -- Make meta SigTv type variables for patten-bound scoped type varaibles
 -- We use SigTvs for them, so that they can't unify with arbitrary types
-tcInstSigTyVars = mapM (\tv -> instMetaTyVar (SigTv (tyVarName tv)) tv)
-		-- ToDo: the "function binding site is bogus
+tcInstSigTyVars = mapM tcInstSigTyVar
+
+tcInstSigTyVar :: TyVar -> TcM TcTyVar
+tcInstSigTyVar tyvar
+  = do	{ uniq <- newMetaUnique
+ 	; ref <- newMutVar Flexi
+        ; let name = setNameUnique (tyVarName tyvar) uniq
+   	        -- Use the same OccName so that the tidy-er 
+		-- doesn't rename 'a' to 'a0' etc
+	      kind = tyVarKind tyvar
+	; return (mkTcTyVar name kind (MetaTv SigTv ref)) }
 \end{code}
 
 
@@ -274,9 +283,9 @@ newMetaTyVar meta_info kind
  	; ref <- newMutVar Flexi
         ; let name = mkTcTyVarName uniq s
               s = case meta_info of
-                        TauTv   -> fsLit "t"
-                        TcsTv   -> fsLit "u"
-                        SigTv _ -> fsLit "a"
+                        TauTv -> fsLit "t"
+                        TcsTv -> fsLit "u"
+                        SigTv -> fsLit "a"
 	; return (mkTcTyVar name kind (MetaTv meta_info ref)) }
 
 mkTcTyVarName :: Unique -> FastString -> Name
@@ -284,16 +293,6 @@ mkTcTyVarName :: Unique -> FastString -> Name
 -- leaving the un-cluttered names free for user names
 mkTcTyVarName uniq str = mkSysTvName uniq str
 
-instMetaTyVar :: MetaInfo -> TyVar -> TcM TcTyVar
--- Make a new meta tyvar whose Name and Kind 
--- come from an existing TyVar
-instMetaTyVar meta_info tyvar
-  = do	{ uniq <- newMetaUnique
- 	; ref <- newMutVar Flexi
-        ; let name = mkSystemName uniq (getOccName tyvar)
-	      kind = tyVarKind tyvar
-	; return (mkTcTyVar name kind (MetaTv meta_info ref)) }
-
 readMetaTyVar :: TyVar -> TcM MetaDetails
 readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
 		      readMutVar (metaTvRef tyvar)
@@ -384,10 +383,6 @@ newFlexiTyVarTy kind = do
 newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
 newFlexiTyVarTys n kind = mapM 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
@@ -397,6 +392,16 @@ tcInstTyVars tyvars
 		-- Since the tyvars are freshly made,
 		-- they cannot possibly be captured by
 		-- any existing for-alls.  Hence zipTopTvSubst
+
+tcInstTyVar :: TyVar -> TcM TcTyVar
+-- Make a new unification variable tyvar whose Name and Kind 
+-- come from an existing TyVar
+tcInstTyVar tyvar
+  = do	{ uniq <- newMetaUnique
+ 	; ref <- newMutVar Flexi
+        ; let name = mkSystemName uniq (getOccName tyvar)
+	      kind = tyVarKind tyvar
+	; return (mkTcTyVar name kind (MetaTv TauTv ref)) }
 \end{code}
 
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 30dccc2437..607637a96e 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -641,7 +641,7 @@ plusImportAvails
   (ImportAvails { imp_mods = mods2,
 		  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
                   imp_orphs = orphs2, imp_finsts = finsts2 })
-  = ImportAvails { imp_mods     = plusModuleEnv_C (++) mods1 mods2,	
+  = ImportAvails { imp_mods     = plusModuleEnv_C (++) mods1 mods2,
 		   imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,	
 		   imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
 		   imp_orphs    = orphs1 `unionLists` orphs2,
@@ -1039,9 +1039,6 @@ data SkolemInfo
                         -- polymorphic Ids, and are now checking that their RHS
                         -- constraints are satisfied.
 
-  | RuntimeUnkSkol      -- a type variable used to represent an unknown
-                        -- runtime type (used in the GHCi debugger)
-
   | BracketSkol         -- Template Haskell bracket
 
   | UnkSkol             -- Unhelpful info (until I improve it)
@@ -1076,8 +1073,7 @@ pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
 -- UnkSkol
 -- For type variables the others are dealt with by pprSkolTvBinding.  
 -- For Insts, these cases should not happen
-pprSkolInfo UnkSkol        = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
-pprSkolInfo RuntimeUnkSkol = WARN( True, text "pprSkolInfo: RuntimeUnkSkol" ) ptext (sLit "RuntimeUnkSkol")
+pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
 \end{code}
 
 
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 13c7377e00..dfaa3dc11a 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -105,7 +105,9 @@ import HsBinds               -- for TcEvBinds stuff
 import Id 
 
 import TcRnTypes
-
+#ifdef DEBUG
+import Control.Monad( when )
+#endif
 import Data.IORef
 \end{code}
 
@@ -423,17 +425,16 @@ type TcsUntouchables = (Untouchables,TcTyVarSet)
 
 \begin{code}
 data SimplContext
-  = SimplInfer		-- Inferring type of a let-bound thing
-  | SimplRuleLhs	-- Inferring type of a RULE lhs
-  | SimplInteractive	-- Inferring type at GHCi prompt
-  | SimplCheck		-- Checking a type signature or RULE rhs
-  deriving Eq
+  = SimplInfer SDoc	   -- Inferring type of a let-bound thing
+  | SimplRuleLhs RuleName  -- Inferring type of a RULE lhs
+  | SimplInteractive	   -- Inferring type at GHCi prompt
+  | SimplCheck SDoc	   -- Checking a type signature or RULE rhs
 
 instance Outputable SimplContext where
-  ppr SimplInfer       = ptext (sLit "SimplInfer")
-  ppr SimplRuleLhs     = ptext (sLit "SimplRuleLhs")
+  ppr (SimplInfer d)   = ptext (sLit "SimplInfer") <+> d
+  ppr (SimplCheck d)   = ptext (sLit "SimplCheck") <+> d
+  ppr (SimplRuleLhs n) = ptext (sLit "SimplRuleLhs") <+> doubleQuotes (ftext n)
   ppr SimplInteractive = ptext (sLit "SimplInteractive")
-  ppr SimplCheck       = ptext (sLit "SimplCheck")
 
 isInteractive :: SimplContext -> Bool
 isInteractive SimplInteractive = True
@@ -443,14 +444,14 @@ simplEqsOnly :: SimplContext -> Bool
 -- Simplify equalities only, not dictionaries
 -- This is used for the LHS of rules; ee
 -- Note [Simplifying RULE lhs constraints] in TcSimplify
-simplEqsOnly SimplRuleLhs = True
-simplEqsOnly _            = False
+simplEqsOnly (SimplRuleLhs {}) = True
+simplEqsOnly _                 = False
 
 performDefaulting :: SimplContext -> Bool
-performDefaulting SimplInfer   	   = False
-performDefaulting SimplRuleLhs 	   = False
-performDefaulting SimplInteractive = True
-performDefaulting SimplCheck       = True
+performDefaulting (SimplInfer {})   = False
+performDefaulting (SimplRuleLhs {}) = False
+performDefaulting SimplInteractive  = True
+performDefaulting (SimplCheck {})   = True
 
 ---------------
 newtype TcS a = TcS { unTcS :: TcSEnv -> TcM a } 
@@ -527,8 +528,10 @@ runTcS context untouch tcs
        ; mapM_ do_unification (varEnvElts ty_binds)
 
 #ifdef DEBUG
---       ; count <- TcM.readTcRef step_count
---       ; TcM.dumpTcRn (ptext (sLit "Constraint solver steps =") <+> int count)
+       ; count <- TcM.readTcRef step_count
+       ; when (count > 0) $
+         TcM.debugDumpTcRn (ptext (sLit "Constraint solver steps =") 
+                            <+> int count <+> ppr context)
 #endif
              -- And return
        ; ev_binds      <- TcM.readTcRef evb_ref
@@ -565,8 +568,9 @@ recoverTcS (TcS recovery_code) (TcS thing_inside)
 
 ctxtUnderImplic :: SimplContext -> SimplContext
 -- See Note [Simplifying RULE lhs constraints] in TcSimplify
-ctxtUnderImplic SimplRuleLhs = SimplCheck
-ctxtUnderImplic ctxt         = ctxt
+ctxtUnderImplic (SimplRuleLhs n) = SimplCheck (ptext (sLit "lhs of rule") 
+                                               <+> doubleQuotes (ftext n))
+ctxtUnderImplic ctxt              = ctxt
 
 tryTcS :: TcS a -> TcS a
 -- Like runTcS, but from within the TcS monad 
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 0012b1ea5b..57ff63649a 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -51,7 +51,7 @@ simplifyTop :: WantedConstraints -> TcM (Bag EvBind)
 -- but when there is nothing to quantify we don't wrap
 -- in a degenerate implication, so we do that here instead
 simplifyTop wanteds 
-  = simplifyCheck SimplCheck wanteds
+  = simplifyCheck (SimplCheck (ptext (sLit "top level"))) wanteds
 
 ------------------
 simplifyInteractive :: WantedConstraints -> TcM (Bag EvBind)
@@ -63,7 +63,8 @@ simplifyDefault :: ThetaType	-- Wanted; has no type variables in it
                 -> TcM ()	-- Succeeds iff the constraint is soluble
 simplifyDefault theta
   = do { wanted <- newFlatWanteds DefaultOrigin theta
-       ; _ignored_ev_binds <- simplifyCheck SimplCheck (mkFlatWC wanted)
+       ; _ignored_ev_binds <- simplifyCheck (SimplCheck (ptext (sLit "defaults"))) 
+                                            (mkFlatWC wanted)
        ; return () }
 \end{code}
 
@@ -77,13 +78,14 @@ simplifyDefault theta
 
 \begin{code}
 simplifyDeriv :: CtOrigin
-		-> [TyVar]	
-		-> ThetaType		-- Wanted
-	        -> TcM ThetaType	-- Needed
+              -> PredType
+	      -> [TyVar]	
+	      -> ThetaType		-- Wanted
+	      -> TcM ThetaType	-- Needed
 -- Given  instance (wanted) => C inst_ty 
 -- Simplify 'wanted' as much as possibles
 -- Fail if not possible
-simplifyDeriv orig tvs theta 
+simplifyDeriv orig pred tvs theta 
   = do { tvs_skols <- tcInstSkolTyVars tvs -- Skolemize
       	 	-- The constraint solving machinery 
 		-- expects *TcTyVars* not TyVars.  
@@ -92,12 +94,13 @@ simplifyDeriv orig tvs theta
 
        ; let skol_subst = zipTopTvSubst tvs $ map mkTyVarTy tvs_skols
              subst_skol = zipTopTvSubst tvs_skols $ map mkTyVarTy tvs
+	     doc = parens $ ptext (sLit "deriving") <+> parens (ppr pred)
 
        ; wanted <- newFlatWanteds orig (substTheta skol_subst theta)
 
        ; traceTc "simplifyDeriv" (ppr tvs $$ ppr theta $$ ppr wanted)
        ; (residual_wanted, _binds)
-             <- runTcS SimplInfer NoUntouchables $
+             <- runTcS (SimplInfer doc) NoUntouchables $
                 solveWanteds emptyInert (mkFlatWC wanted)
 
        ; let (good, bad) = partitionBagWith get_good (wc_flat residual_wanted)
@@ -249,7 +252,7 @@ simplifyInfer top_lvl apply_mr name_taus wanteds
             -- Step 2 
        	    -- Now simplify the possibly-bound constraints
        ; (simpl_results, tc_binds0)
-           <- runTcS SimplInfer NoUntouchables $
+           <- runTcS (SimplInfer (ppr (map fst name_taus))) NoUntouchables $
               simplifyWithApprox (zonked_wanteds { wc_flat = perhaps_bound })
 
        ; when (insolubleWC simpl_results)  -- Fail fast if there is an insoluble constraint
@@ -549,7 +552,7 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
 		 -- variables; hence *no untouchables*
 
        ; (lhs_results, lhs_binds)
-              <- runTcS SimplRuleLhs untch $
+              <- runTcS (SimplRuleLhs name) untch $
                  solveWanteds emptyInert zonked_lhs
 
        ; traceTc "simplifyRule" $
@@ -591,7 +594,8 @@ simplifyRule name tv_bndrs lhs_wanted rhs_wanted
 
 	     -- Hence the rather painful ad-hoc treatement here
        ; rhs_binds_var@(EvBindsVar evb_ref _)  <- newTcEvBinds
-       ; rhs_binds1 <- simplifyCheck SimplCheck $
+       ; let doc = ptext (sLit "rhs of rule") <+> doubleQuotes (ftext name)
+       ; rhs_binds1 <- simplifyCheck (SimplCheck doc) $
             WC { wc_flat = emptyBag
                , wc_insol = emptyBag
                , wc_impl = unitBag $
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index f2b090b94c..5d0bf4839a 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -311,14 +311,12 @@ data MetaInfo
      		   -- A TauTv is always filled in with a tau-type, which
 		   -- never contains any ForAlls 
 
-   | SigTv Name	   -- A variant of TauTv, except that it should not be
+   | SigTv 	   -- 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
-		   -- The Name is the name of the function from whose
-		   -- type signature we got this skolem
 
    | TcsTv	   -- A MetaTv allocated by the constraint solver
      		   -- Its particular property is that it is always "touchable"
@@ -397,12 +395,12 @@ kind_var_occ = mkOccName tvName "k"
 \begin{code}
 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 -- For debugging
-pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
-pprTcTyVarDetails (RuntimeUnk {})      = ptext (sLit "rt")
-pprTcTyVarDetails (FlatSkol {})        = ptext (sLit "fsk")
-pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
-pprTcTyVarDetails (MetaTv TcsTv _)     = ptext (sLit "tcs")
-pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
+pprTcTyVarDetails (SkolemTv {})     = ptext (sLit "sk")
+pprTcTyVarDetails (RuntimeUnk {})  = ptext (sLit "rt")
+pprTcTyVarDetails (FlatSkol {})    = ptext (sLit "fsk")
+pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
+pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig")
 
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
 pprUserTypeCtxt (FunSigCtxt n)  = ptext (sLit "the type signature for") <+> quotes (ppr n)
@@ -586,9 +584,9 @@ isTyConableTyVar tv
 	-- not a SigTv
   = ASSERT( isTcTyVar tv) 
     case tcTyVarDetails tv of
-        MetaTv (SigTv _) _ -> False
-	_                  -> True
-
+	MetaTv SigTv _ -> False
+	_              -> True
+	
 isSkolemTyVar tv 
   = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
@@ -617,8 +615,8 @@ isSigTyVar :: Var -> Bool
 isSigTyVar tv 
   = ASSERT( isTcTyVar tv )
     case tcTyVarDetails tv of
-	MetaTv (SigTv _) _ -> True
-	_                  -> False
+	MetaTv SigTv _ -> True
+	_              -> False
 
 metaTvRef :: TyVar -> IORef MetaDetails
 metaTvRef tv 
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 0dfe3941c5..a6c9c478d3 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -888,8 +888,8 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
     ty1       = mkTyVarTy tv1
     ty2       = mkTyVarTy tv2
 
-    nicer_to_update_tv1 _         (SigTv _) = True
-    nicer_to_update_tv1 (SigTv _) _         = False
+    nicer_to_update_tv1 _     SigTv = True
+    nicer_to_update_tv1 SigTv _     = False
     nicer_to_update_tv1 _         _         = isSystemName (Var.varName tv1)
         -- Try not to update SigTvs; and try to update sys-y type
         -- variables in preference to ones gotten (say) by
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 446341db80..87ffacd226 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -567,9 +567,7 @@ instance Outputable name => OutputableBndr (IPName name) where
 	-- OK, here's the main printer
 
 ppr_type :: Prec -> Type -> SDoc
-ppr_type _ (TyVarTy tv)         -- Note [Infix type variables]
-  | isSymOcc (getOccName tv)  = parens (ppr tv)
-  | otherwise		      = ppr tv
+ppr_type _ (TyVarTy tv)	      = ppr_tvar tv
 ppr_type p (PredTy pred)      = maybeParen p TyConPrec $
                                 ifPprDebug (ptext (sLit "<pred>")) <> (pprPredTy pred)
 ppr_type p (TyConApp tc tys)  = pprTcApp p ppr_type tc tys
@@ -605,17 +603,62 @@ ppr_forall_type p ty
     split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
     split2 ps ty		    = (reverse ps, ty)
 
+ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
+ppr_tc_app _ tc []
+  = ppr_tc tc
+ppr_tc_app _ tc [ty]
+  | tc `hasKey` listTyConKey = brackets (pprType ty)
+  | tc `hasKey` parrTyConKey = ptext (sLit "[:") <> pprType ty <> ptext (sLit ":]")
+  | tc `hasKey` liftedTypeKindTyConKey   = ptext (sLit "*")
+  | tc `hasKey` unliftedTypeKindTyConKey = ptext (sLit "#")
+  | tc `hasKey` openTypeKindTyConKey     = ptext (sLit "(?)")
+  | tc `hasKey` ubxTupleKindTyConKey     = ptext (sLit "(#)")
+  | tc `hasKey` argTypeKindTyConKey      = ptext (sLit "??")
+
+ppr_tc_app p tc tys
+  | isTupleTyCon tc && tyConArity tc == length tys
+  = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
+  | otherwise
+  = ppr_type_app p (getName tc) tys
+
+ppr_type_app :: Prec -> Name -> [Type] -> SDoc
+-- Used for classes as well as types; that's why it's separate from ppr_tc_app
+ppr_type_app p tc tys
+  | is_sym_occ		-- Print infix if possible
+  , [ty1,ty2] <- tys	-- We know nothing of precedence though
+  = maybeParen p FunPrec (sep [ppr_type FunPrec ty1, 
+			       pprInfixVar True (ppr tc) <+> ppr_type FunPrec ty2])
+  | otherwise
+  = maybeParen p TyConPrec (hang (pprPrefixVar is_sym_occ (ppr tc))
+    	       	 	       2 (sep (map pprParendType tys)))
+  where
+    is_sym_occ = isSymOcc (getOccName tc)
+
+ppr_tc :: TyCon -> SDoc	-- No brackets for SymOcc
+ppr_tc 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
+
+ppr_tvar :: TyVar -> SDoc
+ppr_tvar tv  -- Note [Infix type variables]
+  | isSymOcc (getOccName tv)  = parens (ppr tv)
+  | otherwise		      = ppr tv
+
 -------------------
 pprForAll :: [TyVar] -> SDoc
 pprForAll []  = empty
 pprForAll tvs = ptext (sLit "forall") <+> sep (map pprTvBndr tvs) <> dot
 
 pprTvBndr :: TyVar -> SDoc
-pprTvBndr tv
-  | isLiftedTypeKind kind = ppr tv
-  | otherwise             = parens (ppr tv <+> dcolon <+> pprKind kind)
-  where
-    kind = tyVarKind tv
+pprTvBndr tv 
+  | isLiftedTypeKind kind = ppr_tvar tv
+  | otherwise	          = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
+	     where
+	       kind = tyVarKind tv
 \end{code}
 
 Note [Infix type variables]
diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index 097a112359..700878aea6 100644
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -41,6 +41,7 @@ data Bag a
   | UnitBag a
   | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty
   | ListBag [a]             -- INVARIANT: the list is non-empty
+    deriving Typeable
 
 emptyBag :: Bag a
 emptyBag = EmptyBag
@@ -262,8 +263,6 @@ bagToList b = foldrBag (:) [] b
 instance (Outputable a) => Outputable (Bag a) where
     ppr bag = braces (pprWithCommas ppr (bagToList bag))
 
-INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")
-
 instance Data a => Data (Bag a) where
   gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly
   toConstr _   = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"
diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 388b96844c..1fa4199aa2 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -61,14 +61,14 @@ addNode k node graph
  	-- add back conflict edges from other nodes to this one
  	map_conflict	
 		= foldUniqSet 
-			(adjustUFM (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
+			(adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
 			(graphMap graph)
 			(nodeConflicts node)
 			
 	-- add back coalesce edges from other nodes to this one
 	map_coalesce
 		= foldUniqSet
-			(adjustUFM (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
+			(adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
 			map_conflict
 			(nodeCoalesce node)
 	
@@ -434,7 +434,7 @@ freezeNode k
 		else node 	-- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
 				-- If the edge isn't actually in the coelesce set then just ignore it.
 
-	fm2	= foldUniqSet (adjustUFM (freezeEdge k)) fm1
+	fm2	= foldUniqSet (adjustUFM_C (freezeEdge k)) fm1
 	   		$ nodeCoalesce node
 
     in	fm2
@@ -604,7 +604,7 @@ setColor
 	
 setColor u color
  	= graphMapModify
- 	$ adjustUFM
+ 	$ adjustUFM_C
 		(\n -> n { nodeColor = Just color })
 		u 
 	
@@ -621,13 +621,14 @@ adjustWithDefaultUFM f def k map
 		map
 		k def
 		
-{-# INLINE adjustUFM #-}
-adjustUFM 
+-- Argument order different from UniqFM's adjustUFM
+{-# INLINE adjustUFM_C #-}
+adjustUFM_C 
 	:: Uniquable k
 	=> (a -> a)
 	-> k -> UniqFM a -> UniqFM a
 
-adjustUFM f k map
+adjustUFM_C f k map
  = case lookupUFM map k of
  	Nothing	-> map
 	Just a	-> addToUFM map k (f a)
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index e178e99f0d..c4a685b3b5 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -60,7 +60,7 @@ module Outputable (
 	
 	-- * Error handling and debugging utilities
 	pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError, 
-	pprTrace, warnPprTrace,
+	pprTrace, pprDefiniteTrace, warnPprTrace,
 	trace, pgmError, panic, sorry, panicFastInt, assertPanic
     ) where
 
@@ -800,6 +800,9 @@ pprTrace str doc x
    | opt_NoDebugOutput = x
    | otherwise         = pprAndThen trace str doc x
 
+pprDefiniteTrace :: String -> SDoc -> a -> a
+-- ^ Same as pprTrace, but show even if -dno-debug-output is on
+pprDefiniteTrace str doc x = pprAndThen trace str doc x
 
 pprPanicFastInt :: String -> SDoc -> FastInt
 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 31d1e878c6..7302b0295e 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -36,6 +36,8 @@ module UniqFM (
 	addListToUFM,addListToUFM_C,
 	addToUFM_Directly,
 	addListToUFM_Directly,
+	adjustUFM,
+	adjustUFM_Directly,
 	delFromUFM,
 	delFromUFM_Directly,
 	delListFromUFM,
@@ -53,12 +55,15 @@ module UniqFM (
 	lookupUFM, lookupUFM_Directly,
 	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
 	eltsUFM, keysUFM, splitUFM,
-	ufmToList 
+	ufmToList,
+	joinUFM
     ) where
 
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
+import Compiler.Hoopl   hiding (Unique)
+
 import qualified Data.IntMap as M
 \end{code}
 
@@ -103,6 +108,9 @@ addListToUFM_C	:: Uniquable key => (elt -> elt -> elt)
 			   -> UniqFM elt -> [(key,elt)]
 			   -> UniqFM elt
 
+adjustUFM	:: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
+adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> 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
@@ -175,6 +183,9 @@ addToUFM_Acc exi new (UFM m) k v =
   UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
 
+adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
+adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
+
 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
 delListFromUFM = foldl delFromUFM
 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
@@ -207,6 +218,16 @@ keysUFM (UFM m) = map getUnique $ M.keys m
 eltsUFM (UFM m) = M.elems m
 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 
+-- Hoopl
+joinUFM :: JoinFun v -> JoinFun (UniqFM v)
+joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
+    where add k new_v (ch, joinmap) =
+            case lookupUFM_Directly joinmap k of
+                Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
+                Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
+                                (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
+                                (NoChange, _) -> (ch, joinmap)
+
 \end{code}
 
 %************************************************************************
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 0e46889ec5..dc4f32ec5e 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -66,6 +66,9 @@ module Util (
         -- * Floating point
         readRational,
 
+        -- * read helpers
+        maybeReadFuzzy,
+
         -- * IO-ish utilities
         createDirectoryHierarchy,
         doesDirNameExist,
@@ -966,6 +969,17 @@ readRational top_s
 
 
 -----------------------------------------------------------------------------
+-- read helpers
+
+maybeReadFuzzy :: Read a => String -> Maybe a
+maybeReadFuzzy str = case reads str of
+                     [(x, s)]
+                      | all isSpace s ->
+                         Just x
+                     _ ->
+                         Nothing
+
+-----------------------------------------------------------------------------
 -- Create a hierarchy of directories
 
 createDirectoryHierarchy :: FilePath -> IO ()
diff --git a/configure.ac b/configure.ac
index 7baa3ddb5c..d2deeb6c06 100644
--- a/configure.ac
+++ b/configure.ac
@@ -132,10 +132,15 @@ if test "$WithGhc" != ""; then
   GhcCanonVersion="$GhcMajVersion$GhcMinVersion2"
   if test $GhcCanonVersion -ge 613; then ghc_ge_613=YES; else ghc_ge_613=NO; fi
   AC_SUBST(ghc_ge_613)dnl
+
+  BOOTSTRAPPING_GHC_INFO_FIELD([CC_STAGE0],[C compiler command],['$(CC)'])
+  BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command],['$(AR)'])
+  BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags],['$(AR_OPTS)'])
+  BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file],['$(ArSupportsAtFile)'])
 fi
 
 dnl ** Must have GHC to build GHC, unless --enable-hc-boot is on
-if test "$BootingFromHc" = "NO" -a -d "$srcdir/compiler"; then
+if test "$BootingFromHc" = "NO"; then
   if test "$WithGhc" = ""; then
      AC_MSG_ERROR([GHC is required unless bootstrapping from .hc files.])
   fi
@@ -303,12 +308,15 @@ checkOS "$TargetOS"
 
 # Verify that the installed (bootstrap) GHC is capable of generating
 # code for the requested build platform.
-if test "$BuildPlatform" != "$bootstrap_target"
+if test "$BootingFromHc" = "NO"
 then
-    echo "This GHC (${WithGhc}) does not generate code for the build platform"
-    echo "   GHC target platform    : $bootstrap_target"
-    echo "   Desired build platform : $BuildPlatform"
-    exit 1
+    if test "$BuildPlatform" != "$bootstrap_target"
+    then
+        echo "This GHC (${WithGhc}) does not generate code for the build platform"
+        echo "   GHC target platform    : $bootstrap_target"
+        echo "   Desired build platform : $BuildPlatform"
+        exit 1
+    fi
 fi
 
 echo "GHC build  : $BuildPlatform"
@@ -537,7 +545,7 @@ dnl ** look for GCC and find out which version
 dnl     Figure out which C compiler to use.  Gcc is preferred.
 dnl     If gcc, make sure it's at least 2.1
 dnl
-FP_HAVE_GCC
+FP_GCC_VERSION
 
 FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS])
 FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
@@ -578,7 +586,6 @@ AC_DEFINE([HAVE_BIN_SH], [1], [Define to 1 if you have /bin/sh.])
 dnl ** how to invoke `ar' and `ranlib'
 FP_PROG_AR_SUPPORTS_ATFILE
 FP_PROG_AR_NEEDS_RANLIB
-FP_PROG_AR_SUPPORTS_INPUT
 
 dnl ** Check to see whether ln -s works
 AC_PROG_LN_S
@@ -931,7 +938,7 @@ if grep '	' compiler/ghc.cabal.in 2>&1 >/dev/null; then
    AC_MSG_ERROR([compiler/ghc.cabal.in contains tab characters; please remove them])
 fi
 
-AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal ghc.spec extra-gcc-opts docs/users_guide/ug-book.xml docs/users_guide/ug-ent.xml docs/index.html libraries/prologue.txt distrib/ghc.iss distrib/configure.ac])
+AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal ghc.spec settings docs/users_guide/ug-book.xml docs/users_guide/ug-ent.xml docs/index.html libraries/prologue.txt distrib/ghc.iss distrib/configure.ac])
 AC_CONFIG_COMMANDS([mk/stamp-h],[echo timestamp > mk/stamp-h])
 AC_OUTPUT
 
diff --git a/distrib/Makefile b/distrib/Makefile
index f1d63bc28e..7f8add1f50 100644
--- a/distrib/Makefile
+++ b/distrib/Makefile
@@ -34,7 +34,7 @@ install::
 	$(MAKE) -C gmp       install      DOING_BIN_DIST=YES
 	$(MAKE) -C docs      install-docs DOING_BIN_DIST=YES
 	$(MAKE) -C libraries/Cabal/doc install-docs DOING_BIN_DIST=YES
-	$(INSTALL_DATA) $(INSTALL_OPTS) extra-gcc-opts $(libdir)
+	$(INSTALL_DATA) $(INSTALL_OPTS) settings $(libdir)
 
 install :: postinstall denounce
 
diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in
index d5aa2be68d..7df0f3b52b 100644
--- a/distrib/configure.ac.in
+++ b/distrib/configure.ac.in
@@ -55,7 +55,7 @@ export CC
 WhatGccIsCalled="$CC"
 AC_SUBST(WhatGccIsCalled)
 
-FP_HAVE_GCC
+FP_GCC_VERSION
 AC_PROG_CPP
 
 #
@@ -88,7 +88,7 @@ dnl ** how to invoke `ar' and `ranlib'
 FP_PROG_AR_NEEDS_RANLIB
 
 #
-AC_CONFIG_FILES(extra-gcc-opts mk/config.mk mk/install.mk)
+AC_CONFIG_FILES(settings mk/config.mk mk/install.mk)
 AC_OUTPUT
 
 # We get caught by
diff --git a/docs/users_guide/debugging.xml b/docs/users_guide/debugging.xml
index 6fc1413bb1..b84134ad13 100644
--- a/docs/users_guide/debugging.xml
+++ b/docs/users_guide/debugging.xml
@@ -476,6 +476,88 @@
           style.</para>
 	</listitem>
       </varlistentry>
+    </variablelist>
+  </sect2>
+
+  <sect2 id="formatting dumps">
+    <title>Formatting dumps</title>
+
+    <indexterm><primary>formatting dumps</primary></indexterm>
+
+     <variablelist>
+      <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.  Its default value is 5.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
+          <option>-dppr-colsNNN</option>
+          <indexterm><primary><option>-dppr-colsNNN</option></primary></indexterm>
+        </term>
+	<listitem>
+	  <para>Set the width of debugging output. Use this if your code is wrapping too much.
+		For example: <option>-dppr-cols200</option>.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
+          <option>-dppr-case-as-let</option>
+          <indexterm><primary><option>-dppr-case-as-let</option></primary></indexterm>
+        </term>
+	<listitem>
+	  <para>Print single alternative case expressions as though they were strict 
+		let expressions. This is helpful when your code does a lot of unboxing.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term>
+          <option>-dno-debug-output</option>
+          <indexterm><primary><option>-dno-debug-output</option></primary></indexterm>
+        </term>
+        <listitem>
+          <para>Suppress any unsolicited debugging output.  When GHC
+            has been built with the <literal>DEBUG</literal> option it
+            occasionally emits debug output of interest to developers.
+            The extra output can confuse the testing framework and
+            cause bogus test failures, so this flag is provided to
+            turn it off.</para>
+        </listitem>
+      </varlistentry>
+     </variablelist>
+
+  </sect2>
+
+  <sect2 id="supression">
+    <title>Suppressing unwanted information</title>
+
+    <indexterm><primary>suppression</primary></indexterm>
+
+    Core dumps contain a large amount of information. Depending on what you are doing, not all of it will be useful.
+    Use these flags to suppress the parts that you are not interested in.
+
+    <variablelist>
+      <varlistentry>
+	<term>
+          <option>-dsuppress-all</option>
+          <indexterm><primary><option>-dsuppress-all</option></primary></indexterm>
+        </term>
+	<listitem>
+	  <para>Suppress everything that can be suppressed, except for unique ids as this often 
+		makes the printout ambiguous. If you just want to see the overall structure of
+		the code, then start here.</para>
+	</listitem>
+      </varlistentry>
 
       <varlistentry>
 	<term>
@@ -483,7 +565,7 @@
           <indexterm><primary><option>-dsuppress-uniques</option></primary></indexterm>
         </term>
 	<listitem>
-	  <para>Suppress the printing of uniques in debugging output. This may make 
+	  <para>Suppress the printing of uniques. This may make 
 	  the printout ambiguous (e.g. unclear where an occurrence of 'x' is bound), but
 	  it makes the output of two compiler runs have many fewer gratuitous differences,
 	    so you can realistically apply <command>diff</command>.  Once <command>diff</command>
@@ -493,12 +575,13 @@
 
       <varlistentry>
 	<term>
-          <option>-dsuppress-coercions</option>
-          <indexterm><primary><option>-dsuppress-coercions</option></primary></indexterm>
+          <option>-dsuppress-idinfo</option>
+          <indexterm><primary><option>-dsuppress-idinfo</option></primary></indexterm>
         </term>
 	<listitem>
-          <para>Suppress the printing of coercions in Core dumps to make them
-shorter.</para>
+	  <para>Suppress extended information about identifiers where they are bound. This includes
+		strictness information and inliner templates. Using this flag can cut the size 
+		of the core dump in half, due to the lack of inliner templates</para>
 	</listitem>
       </varlistentry>
 
@@ -508,36 +591,39 @@ shorter.</para>
           <indexterm><primary><option>-dsuppress-module-prefixes</option></primary></indexterm>
         </term>
 	<listitem>
-          <para>Suppress the printing of module qualification prefixes in Core dumps to make them easier to read.</para>
+          <para>Suppress the printing of module qualification prefixes.
+	        This is the <constant>Data.List</constant> in <constant>Data.List.length</constant>.</para>
 	</listitem>
       </varlistentry>
 
       <varlistentry>
 	<term>
-          <option>-dppr-user-length</option>
-          <indexterm><primary><option>-dppr-user-length</option></primary></indexterm>
+          <option>-dsuppress-type-signatures</option>
+          <indexterm><primary><option>-dsuppress-type-signatures</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.  Its default value is 5.</para>
+          <para>Suppress the printing of type signatures.</para>
 	</listitem>
       </varlistentry>
 
       <varlistentry>
-        <term>
-          <option>-dno-debug-output</option>
-          <indexterm><primary><option>-dno-debug-output</option></primary></indexterm>
+	<term>
+          <option>-dsuppress-type-applications</option>
+          <indexterm><primary><option>-dsuppress-type-applications</option></primary></indexterm>
         </term>
-        <listitem>
-          <para>Suppress any unsolicited debugging output.  When GHC
-            has been built with the <literal>DEBUG</literal> option it
-            occasionally emits debug output of interest to developers.
-            The extra output can confuse the testing framework and
-            cause bogus test failures, so this flag is provided to
-            turn it off.</para>
-        </listitem>
+	<listitem>
+          <para>Suppress the printing of type applications.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
+          <option>-dsuppress-coercions</option>
+          <indexterm><primary><option>-dsuppress-coercions</option></primary></indexterm>
+        </term>
+	<listitem>
+          <para>Suppress the printing of type coercions.</para>
+	</listitem>
       </varlistentry>
     </variablelist>
   </sect2>
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index e0940aec0d..73faae7f97 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1180,6 +1180,13 @@
 	  </row>
 
 	  <row>
+	    <entry><option>-fwarn-missing-local-sigs</option></entry>
+	    <entry>warn about polymorphic local bindings without signatures</entry>
+	    <entry>dynamic</entry>
+	    <entry><option>-fno-warn-missing-local-sigs</option></entry>
+	  </row>
+
+	  <row>
 	    <entry><option>-fwarn-name-shadowing</option></entry>
 	    <entry>warn when names are shadowed</entry>
 	    <entry>dynamic</entry>
@@ -2461,32 +2468,68 @@ phase <replaceable>n</replaceable></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>-dppr-colsNNN</option></entry>
+	      <entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry>
+	      <entry>static</entry>
+	      <entry>-</entry>
+	    </row>
+	    <row>
+	      <entry><option>-dppr-case-as-let</option></entry>
+	      <entry>Print single alternative case expressions as strict lets.</entry>
+	      <entry>static</entry>
+	      <entry>-</entry>
+	    </row>
+	    <row>
+	      <entry><option>-dsuppress-all</option></entry>
+	      <entry>In core dumps, suppress everything that is suppressable.</entry>
+	      <entry>static</entry>
+	      <entry>-</entry>
+	    </row>
+	    <row>
 	      <entry><option>-dsuppress-uniques</option></entry>
-	      <entry>Suppress the printing of uniques in debug output (easier to use <command>diff</command>.</entry>
+	      <entry>Suppress the printing of uniques in debug output (easier to use <command>diff</command>)</entry>
 	      <entry>static</entry>
 	      <entry>-</entry>
 	    </row>
 	    <row>
-	      <entry><option>-dsuppress-coercions</option></entry>
-	      <entry>Suppress the printing of coercions in Core dumps to make them shorter.</entry>
+	      <entry><option>-dsuppress-idinfo</option></entry>
+	      <entry>Suppress extended information about identifiers where they are bound</entry>
 	      <entry>static</entry>
 	      <entry>-</entry>
 	    </row>
 	    <row>
 	      <entry><option>-dsuppress-module-prefixes</option></entry>
-	      <entry>Suppress the printing of module qualification prefixes in Core dumps to make them easier to read.</entry>
+	      <entry>Suppress the printing of module qualification prefixes</entry>
 	      <entry>static</entry>
 	      <entry>-</entry>
 	    </row>
 	    <row>
-	      <entry><option>-dppr-noprags</option></entry>
-	      <entry>Don't output pragma info in dumps</entry>
+	      <entry><option>-dsuppress-type-signatures</option></entry>
+	      <entry>Suppress type signatures</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><option>-dsuppress-type-applications</option></entry>
+	      <entry>Suppress type applications</entry>
+	      <entry>static</entry>
+	      <entry>-</entry>
+	    </row>
+	    <row>
+	      <entry><option>-dsuppress-coercions</option></entry>
+	      <entry>Suppress the printing of coercions in Core dumps to make them shorter</entry>
 	      <entry>static</entry>
 	      <entry>-</entry>
 	    </row>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index a5fba51788..9ea3332463 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -5884,7 +5884,7 @@ type variables, in the annotated expression.  For example:
 <programlisting>
   f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool )
 </programlisting>
-Here, the type signature <literal>forall a. ST s Bool</literal> brings the 
+Here, the type signature <literal>forall s. ST s Bool</literal> brings the 
 type variable <literal>s</literal> into scope, in the annotated expression 
 <literal>(op >>= \(x :: STRef s Int) -> g x)</literal>.
 </para>
diff --git a/docs/users_guide/shared_libs.xml b/docs/users_guide/shared_libs.xml
index def773c0a8..89b656a49f 100644
--- a/docs/users_guide/shared_libs.xml
+++ b/docs/users_guide/shared_libs.xml
@@ -16,7 +16,7 @@
     shared between several programs. In contrast, with static linking the
     code is copied into each program. Using shared libraries can thus save
     disk space. They also allow a single copy of code to be shared in memory
-    between several programs that use it. Shared libraires are often used as
+    between several programs that use it. Shared libraries are often used as
     a way of structuring large projects, especially where different parts are
     written in different programming languages. Shared libraries are also
     commonly used as a plugin mechanism by various applications. This is
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 8b08d9d526..115c290491 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -1373,6 +1373,20 @@ module M where
       </varlistentry>
 
       <varlistentry>
+	<term><option>-fwarn-missing-local-sigs</option>:</term>
+	<listitem>
+	  <indexterm><primary><option>-fwarn-missing-local-sigs</option></primary></indexterm>
+	  <indexterm><primary>type signatures, missing</primary></indexterm>
+
+	  <para>If you use the
+          <option>-fwarn-missing-local-sigs</option> flag GHC will warn
+          you about any polymorphic local bindings. As part of
+	    the warning GHC also reports the inferred type. The
+          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>
diff --git a/extra-gcc-opts.in b/extra-gcc-opts.in
deleted file mode 100644
index 8c9832c835..0000000000
--- a/extra-gcc-opts.in
+++ /dev/null
@@ -1 +0,0 @@
-@GccExtraViaCOpts@
diff --git a/ghc.mk b/ghc.mk
index 863ddc2651..b00d92578c 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -227,6 +227,7 @@ include rules/package-config.mk
 # -----------------------------------------------------------------------------
 # Building dependencies
 
+include rules/dependencies.mk
 include rules/build-dependencies.mk
 include rules/include-dependencies.mk
 
@@ -749,7 +750,7 @@ TAGS: TAGS_compiler
 # -----------------------------------------------------------------------------
 # Installation
 
-install: install_packages install_libs install_libexecs install_headers \
+install: install_libs install_packages install_libexecs install_headers \
          install_libexec_scripts install_bins install_topdirs
 ifeq "$(HADDOCK_DOCS)" "YES"
 install: install_docs
@@ -903,7 +904,7 @@ $(eval $(call bindist,.,\
     README \
     INSTALL \
     configure config.sub config.guess install-sh \
-    extra-gcc-opts.in \
+    settings.in \
     packages \
     Makefile \
     mk/config.mk.in \
@@ -932,7 +933,7 @@ $(eval $(call bindist,.,\
     compiler/stage2/doc \
     $(wildcard libraries/*/dist-install/doc/) \
     $(wildcard libraries/*/*/dist-install/doc/) \
-    $(filter-out extra-gcc-opts,$(INSTALL_LIBS)) \
+    $(filter-out settings,$(INSTALL_LIBS)) \
     $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \
     mk/project.mk \
     mk/install.mk.in \
@@ -953,7 +954,7 @@ BIN_DIST_MK = $(BIN_DIST_PREP_DIR)/bindist.mk
 unix-binary-dist-prep:
 	"$(RM)" $(RM_OPTS_REC) bindistprep/
 	"$(MKDIRHIER)" $(BIN_DIST_PREP_DIR)
-	set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh extra-gcc-opts.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done
+	set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done
 	echo "HADDOCK_DOCS       = $(HADDOCK_DOCS)"       >> $(BIN_DIST_MK)
 	echo "LATEX_DOCS         = $(LATEX_DOCS)"         >> $(BIN_DIST_MK)
 	echo "BUILD_DOCBOOK_HTML = $(BUILD_DOCBOOK_HTML)" >> $(BIN_DIST_MK)
@@ -1042,7 +1043,7 @@ SRC_DIST_DIRS = mk rules docs distrib bindisttest libffi includes utils docs rts
 SRC_DIST_FILES += \
 	configure.ac config.guess config.sub configure \
 	aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \
-	ghc.spec.in ghc.spec extra-gcc-opts.in VERSION \
+	ghc.spec.in ghc.spec settings.in VERSION \
 	boot boot-pkgs packages ghc.mk
 
 SRC_DIST_TARBALL = $(SRC_DIST_NAME)-src.tar.bz2
@@ -1157,7 +1158,7 @@ distclean : clean
 	"$(RM)" $(RM_OPTS) config.cache config.status config.log mk/config.h mk/stamp-h
 	"$(RM)" $(RM_OPTS) mk/config.mk mk/are-validating.mk mk/project.mk
 	"$(RM)" $(RM_OPTS) mk/config.mk.old mk/project.mk.old
-	"$(RM)" $(RM_OPTS) extra-gcc-opts docs/users_guide/ug-book.xml
+	"$(RM)" $(RM_OPTS) settings docs/users_guide/ug-book.xml
 	"$(RM)" $(RM_OPTS) compiler/ghc.cabal compiler/ghc.cabal.old
 	"$(RM)" $(RM_OPTS) ghc/ghc-bin.cabal
 	"$(RM)" $(RM_OPTS) libraries/base/include/HsBaseConfig.h
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 9c993345bb..12d8dd202b 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -78,7 +78,8 @@ import Data.Maybe
 main :: IO ()
 main = do
    hSetBuffering stdout NoBuffering
-   GHC.defaultErrorHandler defaultDynFlags $ do
+   let defaultErrorHandlerDynFlags = defaultDynFlags (panic "No settings")
+   GHC.defaultErrorHandler defaultErrorHandlerDynFlags $ do
     -- 1. extract the -B flag from the args
     argv0 <- getArgs
 
@@ -358,9 +359,6 @@ showVersionMode             = mkPreStartupMode ShowVersion
 showNumVersionMode          = mkPreStartupMode ShowNumVersion
 showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
 
-printMode :: String -> Mode
-printMode str              = mkPreStartupMode (Print str)
-
 mkPreStartupMode :: PreStartupMode -> Mode
 mkPreStartupMode = Left
 
@@ -383,8 +381,10 @@ showGhcUsageMode = mkPreLoadMode ShowGhcUsage
 showGhciUsageMode = mkPreLoadMode ShowGhciUsage
 showInfoMode = mkPreLoadMode ShowInfo
 
-printWithDynFlagsMode :: (DynFlags -> String) -> Mode
-printWithDynFlagsMode f = mkPreLoadMode (PrintWithDynFlags f)
+printSetting :: String -> Mode
+printSetting k = mkPreLoadMode (PrintWithDynFlags f)
+    where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
+                   $ lookup k (compilerInfo dflags)
 
 mkPreLoadMode :: PreLoadMode -> Mode
 mkPreLoadMode = Right . Left
@@ -504,14 +504,30 @@ mode_flags =
   , Flag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
   , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
   ] ++
-  [ Flag k'                     (PassFlag (setMode mode))
-  | (k, v) <- compilerInfo,
+  [ Flag k'                     (PassFlag (setMode (printSetting k)))
+  | k <- ["Project version",
+          "Booter version",
+          "Stage",
+          "Build platform",
+          "Host platform",
+          "Target platform",
+          "Have interpreter",
+          "Object splitting supported",
+          "Have native code generator",
+          "Support SMP",
+          "Unregisterised",
+          "Tables next to code",
+          "RTS ways",
+          "Leading underscore",
+          "Debug on",
+          "LibDir",
+          "Global Package DB",
+          "C compiler flags",
+          "Gcc Linker flags",
+          "Ld Linker flags"],
     let k' = "-print-" ++ map (replaceSpace . toLower) k
         replaceSpace ' ' = '-'
         replaceSpace c   = c
-        mode = case v of
-               String str -> printMode str
-               FromDynFlags f -> printWithDynFlagsMode f
   ] ++
       ------- interfaces ----------------------------------------------------
   [ Flag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
@@ -649,9 +665,7 @@ showBanner _postLoadMode dflags = do
 showInfo :: DynFlags -> IO ()
 showInfo dflags = do
         let sq x = " [" ++ x ++ "\n ]"
-        putStrLn $ sq $ concat $ intersperse "\n ," $ map (show . flatten) compilerInfo
-    where flatten (k, String v)       = (k, v)
-          flatten (k, FromDynFlags f) = (k, f dflags)
+        putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
 
 showSupportedExtensions :: IO ()
 showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 420c918615..61b7b340ac 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -14,7 +14,7 @@ Description:
         XXX
 Category: XXX
 Data-Dir: ..
-Data-Files: extra-gcc-opts
+Data-Files: settings
 Build-Type: Simple
 Cabal-Version: >= 1.2
 
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index 8776566106..da9fd8a293 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -108,24 +108,26 @@ all_ghc_stage1 : $(GHC_STAGE1)
 all_ghc_stage2 : $(GHC_STAGE2)
 all_ghc_stage3 : $(GHC_STAGE3)
 
-$(INPLACE_LIB)/extra-gcc-opts : extra-gcc-opts
+$(INPLACE_LIB)/settings : settings
 	"$(CP)" $< $@
 
-# The GHC programs need to depend on all the helper programs they might call
+# The GHC programs need to depend on all the helper programs they might call,
+# and the settings files they use
+
+$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/settings
+$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/settings
+$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/settings
+
 ifeq "$(GhcUnregisterised)" "NO"
-$(GHC_STAGE1) : $(SPLIT)
-$(GHC_STAGE2) : $(SPLIT)
-$(GHC_STAGE3) : $(SPLIT)
+$(GHC_STAGE1) : | $(SPLIT)
+$(GHC_STAGE2) : | $(SPLIT)
+$(GHC_STAGE3) : | $(SPLIT)
 endif
 
-$(GHC_STAGE1) : $(INPLACE_LIB)/extra-gcc-opts
-$(GHC_STAGE2) : $(INPLACE_LIB)/extra-gcc-opts
-$(GHC_STAGE3) : $(INPLACE_LIB)/extra-gcc-opts
-
 ifeq "$(Windows)" "YES"
-$(GHC_STAGE1) : $(TOUCHY)
-$(GHC_STAGE2) : $(TOUCHY)
-$(GHC_STAGE3) : $(TOUCHY)
+$(GHC_STAGE1) : | $(TOUCHY)
+$(GHC_STAGE2) : | $(TOUCHY)
+$(GHC_STAGE3) : | $(TOUCHY)
 endif
 
 ifeq "$(BootingFromHc)" "YES"
@@ -135,7 +137,7 @@ endif
 
 endif
 
-INSTALL_LIBS += extra-gcc-opts
+INSTALL_LIBS += settings
 
 ifeq "$(Windows)" "NO"
 install: install_ghc_link
diff --git a/ghc/ghc.wrapper b/ghc/ghc.wrapper
index 5003f9ae40..083a66db7e 100644
--- a/ghc/ghc.wrapper
+++ b/ghc/ghc.wrapper
@@ -1 +1 @@
-exec "$executablename" -B"$topdir" -pgmc "$pgmgcc" -pgma "$pgmgcc" -pgml "$pgmgcc" -pgmP "$pgmgcc -E -undef -traditional" ${1+"$@"}
+exec "$executablename" -B"$topdir" ${1+"$@"}
diff --git a/libffi/ghc.mk b/libffi/ghc.mk
index 080c43f850..f7caeda782 100644
--- a/libffi/ghc.mk
+++ b/libffi/ghc.mk
@@ -34,8 +34,6 @@
 #
 # We use libffi's own configuration stuff.
 
-PLATFORM := $(shell echo $(HOSTPLATFORM) | sed 's/i[567]86/i486/g')
-
 # 2007-07-05
 # Passing
 #     as_ln_s='cp -p'
@@ -116,16 +114,16 @@ $(libffi_STAMP_CONFIGURE):
 	    PATH=`pwd`:$$PATH; \
 	    export PATH; \
 	    cd build && \
-	    CC=$(WhatGccIsCalled) \
+	    CC=$(CC_STAGE1) \
 	    LD=$(LD) \
-	    AR=$(AR) \
+	    AR=$(AR_STAGE1) \
 	    NM=$(NM) \
         CFLAGS="$(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -w" \
         LDFLAGS="$(SRC_LD_OPTS) $(CONF_GCC_LINKER_OPTS_STAGE1) -w" \
         "$(SHELL)" configure \
 	          --enable-static=yes \
 	          --enable-shared=$(libffi_EnableShared) \
-	          --host=$(PLATFORM) --build=$(PLATFORM)
+	          --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM)
 
 	# libffi.so needs to be built with the correct soname.
 	# NOTE: this builds libffi_convience.so with the incorrect
@@ -179,7 +177,7 @@ $(eval $(call all-target,libffi,$(INSTALL_HEADERS) $(INSTALL_LIBS)))
 libffi/dist-install/build/HSffi.o: libffi/dist-install/build/libHSffi.a
 	cd libffi/dist-install/build && \
 	  touch empty.c && \
-	  "$(CC)" $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -c empty.c -o HSffi.o
+	  "$(CC_STAGE1)" $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -c empty.c -o HSffi.o
 
 $(eval $(call all-target,libffi,libffi/dist-install/build/HSffi.o))
 
@@ -227,4 +225,3 @@ $(eval $(call manual-package-config,libffi))
 # binary-dist
 
 BINDIST_EXTRAS += libffi/package.conf.in
-
diff --git a/libraries/Makefile.common b/libraries/Makefile.common
deleted file mode 100644
index 8fe1462d64..0000000000
--- a/libraries/Makefile.common
+++ /dev/null
@@ -1,118 +0,0 @@
-# This Makefile.common is used only in an nhc98 build of the libraries.
-# It is included from each package's individual Makefile.nhc98.
-# We assume the following definitions have already been made in
-# the importing Makefile.
-#
-# THISPKG = e.g. mypkg
-# SEARCH  = e.g. -P../IO -P../PreludeIO -package base
-# SRCS    = all .hs .gc and .c files
-#
-# EXTRA_H_FLAGS = e.g. -prelude
-# EXTRA_C_FLAGS = e.g. -I../Binary
-include ../Makefile.inc
-
-# nasty hack - replace flags for ghc, nhc98, with hbc specific ones
-ifeq "hbc" "${BUILDCOMP}"
-EXTRA_H_FLAGS := ${EXTRA_HBC_FLAGS}
-endif
-
-DIRS     = $(shell ${LOCAL}pkgdirlist ${THISPKG})
-
-OBJDIR   = ${BUILDDIR}/${OBJ}/libraries/${THISPKG}
-OBJDIRS  = $(patsubst %, ${OBJDIR}/%, ${DIRS})
-FINALLIB = ${DST}/libHS${THISPKG}.$A
-INCDIRS  = ${INCDIR}/packages/${THISPKG} \
-	   $(patsubst %, ${INCDIR}/packages/${THISPKG}/%, ${DIRS})
-.SUFFIXES: .hi .hs .lhs .o .gc .c .hc .p.o .p.c .z.o .z.c .hsc
-
-SRCS_HS  = $(filter %.hs, ${SRCS})
-SRCS_LHS = $(filter %.lhs,${SRCS})
-SRCS_GC  = $(filter %.gc, ${SRCS})
-SRCS_HSC = $(filter %.hsc,${SRCS})
-SRCS_C   = $(filter %.c,  ${SRCS})
-SRCS_HASK= $(SRCS_HS) $(SRCS_LHS) $(SRCS_GC) $(SRCS_HSC)
-
-OBJS_HS  = $(patsubst %.hs, ${OBJDIR}/%.$O, ${SRCS_HS})
-OBJS_LHS = $(patsubst %.lhs,${OBJDIR}/%.$O, ${SRCS_LHS})
-OBJS_GC  = $(patsubst %.gc, ${OBJDIR}/%.$O, ${SRCS_GC})
-OBJS_HSC = $(patsubst %.hsc,${OBJDIR}/%.$O, ${SRCS_HSC})
-OBJS_C   = $(patsubst %.c,  ${OBJDIR}/%.$O, ${SRCS_C})
-OBJS_HASK= ${OBJS_HS} ${OBJS_LHS} ${OBJS_GC} ${OBJS_HSC}
-OBJS     = $(OBJS_HASK) $(OBJS_C)
-
-CFILES_HS  = $(patsubst %.hs, %.$C,  ${SRCS_HS})
-CFILES_LHS = $(patsubst %.lhs,%.$C,  ${SRCS_LHS})
-CFILES_GC  = $(patsubst %.gc, %.$C,  ${SRCS_GC})
-CFILES_XS  = $(patsubst %.gc, %_.$C, ${SRCS_GC}) \
-             $(patsubst %.gc, %_.hs, ${SRCS_GC})
-CFILES_HSC = $(patsubst %.hsc,%.$C,  ${SRCS_HSC})
-CFILES_GEN = ${CFILES_HS} ${CFILES_LHS} ${CFILES_GC} ${CFILES_HSC}
-
-ifeq "p" "${PROFILING}"
-HC += -p
-endif
- 
-ifeq "z" "${TPROF}"
-HC += -z
-endif
-
-all: ${OBJDIR} ${OBJDIRS} ${INCDIRS} extra ${OBJS} ${FINALLIB}
-extra:
-cfiles: extracfiles ${CFILES_GEN}
-extracfiles:
-fromC: ${OBJDIR} ${OBJS_C} ${OBJDIRS}
-	$(HC) -c -d $(OBJDIR) $(EXTRA_C_FLAGS) ${SEARCH} ${CFILES_GEN}
-	echo $(OBJS) | xargs ar cr ${FINALLIB}
-objdir: ${OBJDIR} ${OBJDIRS} ${INCDIRS}
-${OBJDIR} ${OBJDIRS} ${INCDIRS}:
-	mkdir -p $@
-${FINALLIB}: ${OBJS}
-	echo $(OBJS) | xargs ar cr $@
-cleanhi:
-	-rm -f $(patsubst %, %/*.hi, ${DIRS})
-cleanC: cleanExtraC
-	-rm -f ${CFILES_GEN} ${CFILES_XS}
-clean:	cleanhi
-	-rm -f $(patsubst %, ${OBJDIR}/%/*.$O, ${DIRS})
-	-rm -f $(patsubst %.gc, %_.hs, $(filter %.gc, $(SRCS)))
-	-rm -f $(patsubst %.gc, %_.$C,  $(filter %.gc, $(SRCS)))
-cleanExtraC:
-
-# general build rules for making objects from Haskell files
-$(OBJS_HASK): #$(OBJDIR) $(OBJDIRS) $(SRCS_HASK)
-	$(LOCAL)hmake -hc=$(HC) -hidir $(INCDIR)/packages/$(THISPKG) \
-		$(SEARCH) $(EXTRA_H_FLAGS) -d$(OBJDIR) \
-		$(SRCS_HASK)
-${OBJS_HS}: ${OBJDIR}/%.$O : %.hs
-${OBJS_LHS}: ${OBJDIR}/%.$O : %.lhs
-${OBJS_GC}: ${OBJDIR}/%.$O : %.gc
-${OBJS_HSC}: ${OBJDIR}/%.$O : %.hsc
-
-# general build rule for making objects from C files
-${OBJS_C}: ${OBJDIR}/%.$O : cbits/%.c
-	$(CC) -c -I$(INCDIR) $(ENDIAN) $(filter -I%, ${SEARCH}) \
-		$(EXTRA_C_FLAGS) -o $@ $<
-
-# general build rules for making bootstrap C files from Haskell files
-$(CFILES_GEN):
-	$(LOCAL)hmake -hc=$(HC) -C -hidir $(INCDIR)/packages/$(THISPKG) \
-		$(SEARCH) $(EXTRA_H_FLAGS) \
-		$(SRCS_HASK)
-${CFILES_HS}: %.$C : %.hs
-${CFILES_LHS}: %.$C : %.lhs
-${CFILES_GC}: %.$C : %.gc
-${CFILES_HSC}: %.$C : %.hsc
-
-# hack to get round mutual recursion between libraries
-HIFILES = $(patsubst %.hs,../${THISLIB}/%.${HISUFFIX},$(filter %.hs, ${SRCS}))
-${HIFILES}: ../${THISLIB}/%.${HISUFFIX} : %.hs
-	$(HC) -c $(PART_FLAGS) -o /dev/null $<
-
-# The importing Makefile may now define extra individual dependencies
-#    e.g.
-# ${OBJDIR}/Function.$O: Function.hs ${OBJDIR}/Other.$O
-#
-# and C-files dependencies likewise
-#    e.g.
-# AlignBin.c:    BinHandle.c
-
diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc
deleted file mode 100644
index 0b54f52bde..0000000000
--- a/libraries/Makefile.inc
+++ /dev/null
@@ -1,8 +0,0 @@
-ifeq "" "${MKDIR}"
-MKDIR:=$(shell pwd)
-#MKDIR:=$(PWD)
-else
-MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR})
-endif
-include ${MKDIR}/Makefile.inc
-
diff --git a/libraries/Makefile.local b/libraries/Makefile.local
deleted file mode 100644
index 84b90a6563..0000000000
--- a/libraries/Makefile.local
+++ /dev/null
@@ -1,38 +0,0 @@
-# Local GHC-build-tree customization for Cabal makefiles.  We want to build
-# libraries using flags that the user has put in build.mk/validate.mk and
-# appropriate flags for Mac OS X deployment targets.
-
-# Careful here: including boilerplate.mk breaks things, because paths.mk and
-# opts.mk overrides some of the variable settings in the Cabal Makefile, so
-# we just include config.mk and custom-settings.mk.
-include ../defineTOP.mk
-SAVE_GHC := $(GHC)
-SAVE_AR  := $(AR)
-SAVE_LD  := $(LD)
-include $(TOP)/mk/config.mk
-include $(TOP)/mk/custom-settings.mk
-GHC := $(SAVE_GHC)
-AR  := $(SAVE_AR)
-LD  := $(SAVE_LD)
-
-# We want all warnings on
-GhcLibHcOpts += -Wall
-
-# Cabal has problems with deprecated flag warnings, as it needs to pass
-# deprecated flags in pragmas in order to support older GHCs. Thus for
-# now at least we just disable them completely.
-GhcLibHcOpts += -fno-warn-deprecated-flags
-
-ifeq "$(filter-out Win32-% dph%,$(package))" ""
-# XXX We are one of the above list, i.e. we are a package that is not
-# yet warning-clean. Thus turn warnings off for now so that validate
-# goes through.
-GhcLibHcOpts += -w
-endif
-
-# Now add flags from the GHC build system to the Cabal build:
-GHC_OPTS    += $(SRC_HC_OPTS)
-GHC_OPTS    += $(GhcLibHcOpts)
-
-include $(TOP)/mk/bindist.mk
-
diff --git a/libraries/tarballs/time-1.2.0.3.tar.gz b/libraries/tarballs/time-1.2.0.3.tar.gz
deleted file mode 100644
index 525b019556..0000000000
--- a/libraries/tarballs/time-1.2.0.3.tar.gz
+++ /dev/null
diff --git a/libraries/tarballs/time-1.2.0.4.tar.gz b/libraries/tarballs/time-1.2.0.4.tar.gz
new file mode 100644
index 0000000000..6bbbd75703
--- /dev/null
+++ b/libraries/tarballs/time-1.2.0.4.tar.gz
diff --git a/mk/config.mk.in b/mk/config.mk.in
index be8b57bcb7..8796ad4674 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -540,18 +540,19 @@ endif
 # the flag --with-gcc=<blah> instead.  The reason is that the configure script
 # needs to know which gcc you're using in order to perform its tests.
 
-HaveGcc 	= @HaveGcc@
-UseGcc  	= YES
 WhatGccIsCalled = @WhatGccIsCalled@
 GccVersion      = @GccVersion@
-GccLT34		= @GccLT34@
-ifeq "$(strip $(HaveGcc))" "YES"
-ifneq "$(strip $(UseGcc))"  "YES"
-  CC	= cc
-else
-  CC	= $(WhatGccIsCalled)
-endif
-endif
+GccLT34         = @GccLT34@
+CC              = $(WhatGccIsCalled)
+CC_STAGE0       = @CC_STAGE0@
+CC_STAGE1       = $(CC)
+CC_STAGE2       = $(CC)
+CC_STAGE3       = $(CC)
+AS              = $(WhatGccIsCalled)
+AS_STAGE0       = @CC_STAGE0@
+AS_STAGE1       = $(AS)
+AS_STAGE2       = $(AS)
+AS_STAGE3       = $(AS)
 
 # C compiler and linker flags from configure (e.g. -m<blah> to select
 # correct C compiler backend). The stage number is the stage of GHC
@@ -601,10 +602,24 @@ DLLTOOL			= inplace/mingw/bin/dlltool.exe
 
 AR			= @ArCmd@
 AR_OPTS			= @ArArgs@
-ArSupportsInput		= @ArSupportsInput@
 ArSupportsAtFile = @ArSupportsAtFile@
-# Yuckage: for ghc/utils/parallel -- todo: nuke this dependency!!
-BASH                    = /usr/local/bin/bash
+
+AR_STAGE0 = @AR_STAGE0@
+AR_STAGE1 = $(AR)
+AR_STAGE2 = $(AR)
+AR_STAGE3 = $(AR)
+AR_OPTS_STAGE0 = @AR_OPTS_STAGE0@
+AR_OPTS_STAGE1 = $(AR_OPTS)
+AR_OPTS_STAGE2 = $(AR_OPTS)
+AR_OPTS_STAGE3 = $(AR_OPTS)
+EXTRA_AR_ARGS_STAGE0 = $(EXTRA_AR_ARGS)
+EXTRA_AR_ARGS_STAGE1 = $(EXTRA_AR_ARGS)
+EXTRA_AR_ARGS_STAGE2 = $(EXTRA_AR_ARGS)
+EXTRA_AR_ARGS_STAGE3 = $(EXTRA_AR_ARGS)
+ArSupportsAtFile_STAGE0 = @ArSupportsAtFile_STAGE0@
+ArSupportsAtFile_STAGE1 = $(ArSupportsAtFile)
+ArSupportsAtFile_STAGE2 = $(ArSupportsAtFile)
+ArSupportsAtFile_STAGE3 = $(ArSupportsAtFile)
 
 CONTEXT_DIFF		= @ContextDiffCmd@
 CP			= cp
@@ -637,7 +652,6 @@ NROFF			= nroff
 PERL 			= @PerlCmd@
 PYTHON			= @PythonCmd@
 PIC			= pic
-PREPROCESSCMD		= $(CC) -E
 RANLIB			= @RANLIB@
 SED			= @SedCmd@
 TR 			= tr
diff --git a/rts/Hash.c b/rts/Hash.c
index 09d0a06808..9c9b2bce42 100644
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -27,13 +27,16 @@
 
 
 /* Linked list of (key, data) pairs for separate chaining */
-struct hashlist {
+typedef struct hashlist {
     StgWord key;
     void *data;
     struct hashlist *next;  /* Next cell in bucket chain (same hash value) */
-};
+} HashList;
 
-typedef struct hashlist HashList;
+typedef struct chunklist {
+  HashList *chunk;
+  struct chunklist *next;
+} HashListChunk;
 
 struct hashtable {
     int split;		    /* Next bucket to split when expanding */
@@ -43,7 +46,9 @@ struct hashtable {
     int kcount;		    /* Number of keys */
     int bcount;		    /* Number of buckets */
     HashList **dir[HDIRSIZE];	/* Directory of segments */
-    HashFunction *hash;		/* hash function */
+    HashList *freeList;         /* free list of HashLists */
+    HashListChunk *chunks;
+    HashFunction *hash;         /* hash function */
     CompareFunction *compare;   /* key comparison function */
 };
 
@@ -207,30 +212,23 @@ lookupHashTable(HashTable *table, StgWord key)
  * no effort to actually return the space to the malloc arena.
  * -------------------------------------------------------------------------- */
 
-static HashList *freeList = NULL;
-
-static struct chunkList {
-  void *chunk;
-  struct chunkList *next;
-} *chunks;
-
 static HashList *
-allocHashList(void)
+allocHashList (HashTable *table)
 {
     HashList *hl, *p;
-    struct chunkList *cl;
+    HashListChunk *cl;
 
-    if ((hl = freeList) != NULL) {
-	freeList = hl->next;
+    if ((hl = table->freeList) != NULL) {
+        table->freeList = hl->next;
     } else {
         hl = stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList");
 	cl = stgMallocBytes(sizeof (*cl), "allocHashList: chunkList");
-	cl->chunk = hl;
-	cl->next = chunks;
-	chunks = cl;
+        cl->chunk = hl;
+        cl->next = table->chunks;
+        table->chunks = cl;
 
-	freeList = hl + 1;
-	for (p = freeList; p < hl + HCHUNK - 1; p++)
+        table->freeList = hl + 1;
+        for (p = table->freeList; p < hl + HCHUNK - 1; p++)
 	    p->next = p + 1;
 	p->next = NULL;
     }
@@ -238,10 +236,10 @@ allocHashList(void)
 }
 
 static void
-freeHashList(HashList *hl)
+freeHashList (HashTable *table, HashList *hl)
 {
-    hl->next = freeList;
-    freeList = hl;
+    hl->next = table->freeList;
+    table->freeList = hl;
 }
 
 void
@@ -264,7 +262,7 @@ insertHashTable(HashTable *table, StgWord key, void *data)
     segment = bucket / HSEGSIZE;
     index = bucket % HSEGSIZE;
 
-    hl = allocHashList();
+    hl = allocHashList(table);
 
     hl->key = key;
     hl->data = data;
@@ -292,7 +290,7 @@ removeHashTable(HashTable *table, StgWord key, void *data)
 		table->dir[segment][index] = hl->next;
 	    else
 		prev->next = hl->next;
-	    freeHashList(hl);
+            freeHashList(table,hl);
 	    table->kcount--;
 	    return hl->data;
 	}
@@ -317,6 +315,7 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
     long index;
     HashList *hl;
     HashList *next;
+    HashListChunk *cl, *cl_next;
 
     /* The last bucket with something in it is table->max + table->split - 1 */
     segment = (table->max + table->split - 1) / HSEGSIZE;
@@ -328,14 +327,18 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
 		next = hl->next;
 		if (freeDataFun != NULL)
 		    (*freeDataFun)(hl->data);
-		freeHashList(hl);
-	    }
+            }
 	    index--;
 	}
 	stgFree(table->dir[segment]);
 	segment--;
 	index = HSEGSIZE - 1;
     }
+    for (cl = table->chunks; cl != NULL; cl = cl_next) {
+        cl_next = cl->next;
+        stgFree(cl->chunk);
+        stgFree(cl);
+    }
     stgFree(table);
 }
 
@@ -363,6 +366,8 @@ allocHashTable_(HashFunction *hash, CompareFunction *compare)
     table->mask2 = 2 * HSEGSIZE - 1;
     table->kcount = 0;
     table->bcount = HSEGSIZE;
+    table->freeList = NULL;
+    table->chunks = NULL;
     table->hash = hash;
     table->compare = compare;
 
@@ -385,11 +390,5 @@ allocStrHashTable(void)
 void
 exitHashTable(void)
 {
-  struct chunkList *cl;
-
-  while ((cl = chunks) != NULL) {
-    chunks = cl->next;
-    stgFree(cl->chunk);
-    stgFree(cl);
-  }
+    /* nothing to do */
 }
diff --git a/rts/Linker.c b/rts/Linker.c
index 5285ec6d55..c1310b03b0 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -70,12 +70,12 @@
 #include <sys/wait.h>
 #endif
 
-#if defined(linux_HOST_OS    ) || defined(freebsd_HOST_OS) || \
-    defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
-    defined(openbsd_HOST_OS  ) || \
-    ( defined(darwin_HOST_OS ) && !defined(powerpc_HOST_ARCH) ) || \
-    defined(kfreebsdgnu_HOST_OS)
-/* Don't use mmap on powerpc-apple-darwin as mmap doesn't support
+#if !defined(powerpc_HOST_ARCH) && \
+    (   defined(linux_HOST_OS    ) || defined(freebsd_HOST_OS) || \
+        defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
+        defined(openbsd_HOST_OS  ) || defined(darwin_HOST_OS ) || \
+        defined(kfreebsdgnu_HOST_OS) )
+/* Don't use mmap on powerpc_HOST_ARCH as mmap doesn't support
  * reallocating but we need to allocate jump islands just after each
  * object images. Otherwise relative branches to jump islands can fail
  * due to 24-bits displacement overflow.
@@ -1186,11 +1186,11 @@ initLinker( void )
 #   endif /* RTLD_DEFAULT */
 
     compileResult = regcomp(&re_invalid,
-           "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
+           "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
            REG_EXTENDED);
     ASSERT( compileResult == 0 );
     compileResult = regcomp(&re_realso,
-           "GROUP *\\( *(([^ )])+)",
+           "(GROUP|INPUT) *\\( *(([^ )])+)",
            REG_EXTENDED);
     ASSERT( compileResult == 0 );
 #   endif
@@ -1361,8 +1361,8 @@ addDLL( char *dll_name )
          if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
             // success -- try to dlopen the first named file
             IF_DEBUG(linker, debugBelch("match%s\n",""));
-            line[match[1].rm_eo] = '\0';
-            errmsg = internal_dlopen(line+match[1].rm_so);
+            line[match[2].rm_eo] = '\0';
+            errmsg = internal_dlopen(line+match[2].rm_so);
             break;
          }
          // if control reaches here, no GROUP ( ... ) directive was found
@@ -2572,7 +2572,11 @@ static void
 ocFlushInstructionCache( ObjectCode *oc )
 {
     /* The main object code */
-    ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
+    ocFlushInstructionCacheFrom(oc->image
+#ifdef darwin_HOST_OS
+            + oc->misalignment
+#endif
+            , oc->fileSize);
 
     /* Jump Islands */
     ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
diff --git a/rts/Stats.c b/rts/Stats.c
index 159a909fce..fa38472129 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -753,12 +753,18 @@ stat_exit(int alloc)
 	statsClose();
     }
 
-    if (GC_coll_cpu)
+    if (GC_coll_cpu) {
       stgFree(GC_coll_cpu);
-    GC_coll_cpu = NULL;
-    if (GC_coll_elapsed)
+      GC_coll_cpu = NULL;
+    }
+    if (GC_coll_elapsed) {
       stgFree(GC_coll_elapsed);
-    GC_coll_elapsed = NULL;
+      GC_coll_elapsed = NULL;
+    }
+    if (GC_coll_max_pause) {
+      stgFree(GC_coll_max_pause);
+      GC_coll_max_pause = NULL;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -798,6 +804,15 @@ statDescribeGens(void)
       mut = 0;
       for (i = 0; i < n_capabilities; i++) {
           mut += countOccupied(capabilities[i].mut_lists[g]);
+
+          // Add the pinned object block.
+          bd = capabilities[i].pinned_object_block;
+          if (bd != NULL) {
+              gen_live   += bd->free - bd->start;
+              gen_blocks += bd->blocks;
+          }
+
+          gen_live   += gcThreadLiveWords(i,g);
           gen_live   += gcThreadLiveWords(i,g);
           gen_blocks += gcThreadLiveBlocks(i,g);
       }
diff --git a/rts/ghc.mk b/rts/ghc.mk
index df68bc5e2b..a2369452b7 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -194,8 +194,8 @@ endif
 else
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS)
 	"$$(RM)" $$(RM_OPTS) $$@
-	echo $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR)" \
-		$$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@
+	echo $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR_STAGE1)" \
+		$$(AR_OPTS_STAGE1) $$(EXTRA_AR_ARGS_STAGE1) $$@
 endif
 
 endif
@@ -456,8 +456,7 @@ rts_dist_MKDEPENDC_OPTS += -Irts/dist/build
 
 endif
 
-$(eval $(call build-dependencies,rts,dist,1))
-$(eval $(call include-dependencies,rts,dist,1))
+$(eval $(call dependencies,rts,dist,1))
 
 $(rts_dist_depfile_c_asm) : libffi/dist-install/build/ffi.h $(DTRACEPROBES_H)
 
@@ -500,7 +499,7 @@ endif
 ifneq "$(BINDIST)" "YES"
 rts/dist/build/libHSrtsmain.a : rts/dist/build/Main.o
 	"$(RM)" $(RM_OPTS) $@
-	"$(AR)" $(AR_OPTS) $(EXTRA_AR_ARGS) $@ $<
+	"$(AR_STAGE1)" $(AR_OPTS_STAGE1) $(EXTRA_AR_ARGS_STAGE1) $@ $<
 endif
 
 # -----------------------------------------------------------------------------
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index d0dd44dd8a..30361401cc 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -597,11 +597,6 @@ GarbageCollect (rtsBool force_major_gc,
   // update the max size of older generations after a major GC
   resize_generations();
   
-  // Start a new pinned_object_block
-  for (n = 0; n < n_capabilities; n++) {
-      capabilities[n].pinned_object_block = NULL;
-  }
-
   // Free the mark stack.
   if (mark_stack_top_bd != NULL) {
       debugTrace(DEBUG_gc, "mark stack: %d blocks",
@@ -643,8 +638,12 @@ GarbageCollect (rtsBool force_major_gc,
   // zero the scavenged static object list 
   if (major_gc) {
       nat i;
-      for (i = 0; i < n_gc_threads; i++) {
-          zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+      if (n_gc_threads == 1) {
+          zero_static_object_list(gct->scavenged_static_objects);
+      } else {
+          for (i = 0; i < n_gc_threads; i++) {
+              zero_static_object_list(gc_threads[i]->scavenged_static_objects);
+          }
       }
   }
 
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 8ebb9a2513..0ec552c047 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -789,6 +789,7 @@ findMemoryLeak (void)
 
     for (i = 0; i < n_capabilities; i++) {
         markBlocks(nurseries[i].blocks);
+        markBlocks(capabilities[i].pinned_object_block);
     }
 
 #ifdef PROFILING
@@ -880,6 +881,9 @@ memInventory (rtsBool show)
   for (i = 0; i < n_capabilities; i++) {
       ASSERT(countBlocks(nurseries[i].blocks) == nurseries[i].n_blocks);
       nursery_blocks += nurseries[i].n_blocks;
+      if (capabilities[i].pinned_object_block != NULL) {
+          nursery_blocks += capabilities[i].pinned_object_block->blocks;
+      }
   }
 
   retainer_blocks = 0;
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index ae3433a9b2..f8a9e559bf 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -657,17 +657,32 @@ allocatePinned (Capability *cap, lnat n)
     // 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)) {
+        // The pinned_object_block remains attached to the capability
+        // until it is full, even if a GC occurs.  We want this
+        // behaviour because otherwise the unallocated portion of the
+        // block would be forever slop, and under certain workloads
+        // (allocating a few ByteStrings per GC) we accumulate a lot
+        // of slop.
+        //
+        // So, the pinned_object_block is initially marked
+        // BF_EVACUATED so the GC won't touch it.  When it is full,
+        // we place it on the large_objects list, and at the start of
+        // the next GC the BF_EVACUATED flag will be cleared, and the
+        // block will be promoted as usual (if anything in it is
+        // live).
         ACQUIRE_SM_LOCK;
-	cap->pinned_object_block = bd = allocBlock();
-	dbl_link_onto(bd, &g0->large_objects);
-	g0->n_large_blocks++;
+        if (bd != NULL) {
+            dbl_link_onto(bd, &g0->large_objects);
+            g0->n_large_blocks++;
+            g0->n_new_large_words += bd->free - bd->start;
+        }
+        cap->pinned_object_block = bd = allocBlock();
         RELEASE_SM_LOCK;
         initBdescr(bd, g0, g0);
-	bd->flags  = BF_PINNED | BF_LARGE;
+        bd->flags  = BF_PINNED | BF_LARGE | BF_EVACUATED;
 	bd->free   = bd->start;
     }
 
-    g0->n_new_large_words += n;
     p = bd->free;
     bd->free += n;
     return p;
diff --git a/rules/build-package-data.mk b/rules/build-package-data.mk
index 86f9323859..9a66d1beb1 100644
--- a/rules/build-package-data.mk
+++ b/rules/build-package-data.mk
@@ -63,6 +63,11 @@ ifeq "$3" "0"
 $1_$2_CONFIGURE_OPTS += $$(BOOT_PKG_CONSTRAINTS)
 endif
 
+$1_$2_CONFIGURE_OPTS += --with-gcc="$$(CC_STAGE$3)"
+$1_$2_CONFIGURE_OPTS += --configure-option=--with-cc="$$(CC_STAGE$3)"
+$1_$2_CONFIGURE_OPTS += --with-ar="$$(AR_STAGE$3)"
+$1_$2_CONFIGURE_OPTS += --with-ranlib="$$(RANLIB)"
+
 ifneq "$$(BINDIST)" "YES"
 ifneq "$$(NO_GENERATED_MAKEFILE_RULES)" "YES"
 $1/$2/inplace-pkg-config : $1/$2/package-data.mk
@@ -72,7 +77,7 @@ $1/$2/build/autogen/cabal_macros.h : $1/$2/package-data.mk
 # for our build system, and registers the package for use in-place in
 # the build tree.
 $1/$2/package-data.mk : $$(GHC_CABAL_INPLACE) $$($1_$2_GHC_PKG_DEP) $1/$$($1_PACKAGE).cabal $$(wildcard $1/configure) $$($1_$2_HC_CONFIG_DEP)
-	"$$(GHC_CABAL_INPLACE)" configure --with-ghc="$$($1_$2_HC_CONFIG)" --with-ghc-pkg="$$($1_$2_GHC_PKG)" --with-gcc="$$(WhatGccIsCalled)" --configure-option=--with-cc="$$(WhatGccIsCalled)" $$($1_CONFIGURE_OPTS) $$($1_$2_CONFIGURE_OPTS) -- $2 $1
+	"$$(GHC_CABAL_INPLACE)" configure --with-ghc="$$($1_$2_HC_CONFIG)" --with-ghc-pkg="$$($1_$2_GHC_PKG)" $$($1_CONFIGURE_OPTS) $$($1_$2_CONFIGURE_OPTS) -- $2 $1
 ifeq "$$($1_$2_PROG)" ""
 ifneq "$$($1_$2_REGISTER_PACKAGE)" "NO"
 	"$$($1_$2_GHC_PKG)" update --force $$($1_$2_GHC_PKG_OPTS) $1/$2/inplace-pkg-config
diff --git a/rules/build-package-way.mk b/rules/build-package-way.mk
index d6c1560e10..a7dc9182a0 100644
--- a/rules/build-package-way.mk
+++ b/rules/build-package-way.mk
@@ -87,10 +87,10 @@ ifeq "$$($1_$2_SplitObjs)" "YES"
 else
 	echo $$($1_$2_$3_ALL_OBJS) >> $$@.contents
 endif
-ifeq "$$(ArSupportsAtFile)" "YES"
-	"$$(AR)" $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ @$$@.contents
+ifeq "$$($1_$2_ArSupportsAtFile)" "YES"
+	"$$($1_$2_AR)" $$($1_$2_AR_OPTS) $$($1_$2_EXTRA_AR_ARGS) $$@ @$$@.contents
 else
-	"$$(XARGS)" $$(XARGS_OPTS) "$$(AR)" $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ < $$@.contents
+	"$$(XARGS)" $$(XARGS_OPTS) "$$($1_$2_AR)" $$($1_$2_AR_OPTS) $$($1_$2_EXTRA_AR_ARGS) $$@ < $$@.contents
 endif
 	"$$(RM)" $$(RM_OPTS) $$@.contents
 endif
diff --git a/rules/build-package.mk b/rules/build-package.mk
index ac0a8eebce..c735e5137a 100644
--- a/rules/build-package.mk
+++ b/rules/build-package.mk
@@ -100,21 +100,7 @@ $(call hs-sources,$1,$2)
 $(call c-sources,$1,$2)
 $(call includes-sources,$1,$2)
 
-# --- DEPENDENCIES
-# We always have the dependency rules available, as we need to know
-# how to build hsc2hs's dependency file in phase 0
-$(call build-dependencies,$1,$2,$3)
-ifneq "$(phase)" "0"
-# From phase 1 we actually include the dependency files for the
-# bootstrapping stuff
-ifeq "$3" "0"
-$(call include-dependencies,$1,$2,$3)
-else ifeq "$(phase)" "final"
-# In the final phase, we also include the dependency files for
-# everything else
-$(call include-dependencies,$1,$2,$3)
-endif
-endif
+$(call dependencies,$1,$2,$3)
 
 # Now generate all the build rules for each way in this directory:
 $$(foreach way,$$($1_$2_WAYS),$$(eval \
diff --git a/rules/build-prog.mk b/rules/build-prog.mk
index 5c352a2f95..99093d3fee 100644
--- a/rules/build-prog.mk
+++ b/rules/build-prog.mk
@@ -156,7 +156,7 @@ $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2
 	"$$($1_$2_HC)" -o $$@ $$($1_$2_v_ALL_HC_OPTS) $$(LD_OPTS) $$($1_$2_GHC_LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
 else
 $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/.
-	"$$(CC)" -o $$@ $$($1_$2_v_ALL_CC_OPTS) $$(LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_v_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
+	"$$($1_$2_CC)" -o $$@ $$($1_$2_v_ALL_CC_OPTS) $$(LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_v_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
 endif
 
 # Note [lib-depends] if this program is built with stage1 or greater, we
@@ -188,20 +188,6 @@ INSTALL_BINS += $1/$2/build/tmp/$$($1_$2_PROG)
 endif
 endif
 
-# --- DEPENDENCIES
-# We always have the dependency rules available, as we need to know
-# how to build hsc2hs's dependency file in phase 0
-$(call build-dependencies,$1,$2,$3)
-ifneq "$(phase)" "0"
-# From phase 1 we actually include the dependency files for the
-# bootstrapping stuff
-ifeq "$3" "0"
-$(call include-dependencies,$1,$2,$3)
-else ifeq "$(phase)" "final"
-# In the final phase, we also include the dependency files for
-# everything else
-$(call include-dependencies,$1,$2,$3)
-endif
-endif
+$(call dependencies,$1,$2,$3)
 
 endef
diff --git a/rules/c-suffix-rules.mk b/rules/c-suffix-rules.mk
index fa7dd6f840..a4a0b579db 100644
--- a/rules/c-suffix-rules.mk
+++ b/rules/c-suffix-rules.mk
@@ -43,19 +43,19 @@ $1/$2/build/%.$$($3_way_)s : $1/%.c $$($1_$2_HC_DEP)
 else
 
 $1/$2/build/%.$$($3_osuf) : $1/%.c | $$$$(dir $$$$@)/.
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
 
 $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.c
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
 
 $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)s
-	"$$(AS)" $$($1_$2_$3_ALL_AS_OPTS) -o $$@ $$<
+	"$$($1_$2_AS)" $$($1_$2_$3_ALL_AS_OPTS) -o $$@ $$<
 
 $1/$2/build/%.$$($3_osuf) : $1/%.S | $$$$(dir $$$$@)/.
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@
 
 $1/$2/build/%.$$($3_way_)s : $1/$2/build/%.c
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -S $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -S $$< -o $$@
 
 endif
 
diff --git a/rules/dependencies.mk b/rules/dependencies.mk
new file mode 100644
index 0000000000..42605a565c
--- /dev/null
+++ b/rules/dependencies.mk
@@ -0,0 +1,38 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+define dependencies
+$(call trace, dependencies($1,$2,$3))
+$(call profStart, dependencies($1,$2,$3))
+# $1 = dir
+# $2 = distdir
+# $3 = GHC stage to use (0 == bootstrapping compiler)
+
+# We always have the dependency rules available, as we need to know
+# how to build hsc2hs's dependency file in phase 0
+$(call build-dependencies,$1,$2,$3)
+
+ifneq "$(phase)" "0"
+# From phase 1 we actually include the dependency files for the
+# bootstrapping stuff
+ifeq "$3" "0"
+$(call include-dependencies,$1,$2,$3)
+else ifeq "$(phase)" "final"
+# In the final phase, we also include the dependency files for
+# everything else
+$(call include-dependencies,$1,$2,$3)
+endif
+endif
+
+$(call profEnd, dependencies($1,$2,$3))
+endef
+
diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk
index bebbc4d04b..5c56169dc5 100644
--- a/rules/distdir-way-opts.mk
+++ b/rules/distdir-way-opts.mk
@@ -17,9 +17,9 @@ define distdir-way-opts # args: $1 = dir, $2 = distdir, $3 = way, $4 = stage
 
 # Options for a Haskell compilation:
 #   - CONF_HC_OPTS                 source-tree-wide options, selected at
-#				   configure-time
+#                                  configure-time
 #   - SRC_HC_OPTS                  source-tree-wide options from build.mk
-#				   (optimisation, heap settings)
+#                                  (optimisation, heap settings)
 #   - libraries/base_HC_OPTS       options from Cabal for libraries/base
 #                                  for all ways
 #   - libraries/base_MORE_HC_OPTS  options from elsewhere in the build
@@ -27,7 +27,7 @@ define distdir-way-opts # args: $1 = dir, $2 = distdir, $3 = way, $4 = stage
 #   - libraries/base_v_HC_OPTS     options from libraries/base for way v
 #   - WAY_v_HC_OPTS                options for this way
 #   - EXTRA_HC_OPTS                options from the command-line
-#   - -Idir1 -Idir2 ...		   include-dirs from this package
+#   - -Idir1 -Idir2 ...            include-dirs from this package
 #   - -odir/-hidir/-stubdir        put the output files under $3/build
 #   - -osuf/-hisuf/-hcsuf          suffixes for the output files in this way
 
@@ -134,6 +134,8 @@ $1_$2_$3_ALL_HSC2HS_OPTS = \
  --cflag=-D__GLASGOW_HASKELL__=$$(ProjectVersionInt) \
  $$($1_$2_$3_HSC2HS_CC_OPTS) \
  $$($1_$2_$3_HSC2HS_LD_OPTS) \
+ --cflag=-I$1/$2/build/autogen \
+ $$(if $$($1_PACKAGE),--cflag=-include --cflag=$1/$2/build/autogen/cabal_macros.h) \
  $$($$(basename $$<)_HSC2HS_OPTS) \
  $$(EXTRA_HSC2HS_OPTS)
 
diff --git a/rules/hs-suffix-rules-srcdir.mk b/rules/hs-suffix-rules-srcdir.mk
index 7e9c8d377d..bdb9d00282 100644
--- a/rules/hs-suffix-rules-srcdir.mk
+++ b/rules/hs-suffix-rules-srcdir.mk
@@ -52,10 +52,10 @@ endif
 # .hs->.o rule, I don't know why --SDM
 
 $1/$2/build/%.$$($3_osuf) : $1/$4/%.hc includes/ghcautoconf.h includes/ghcplatform.h | $$$$(dir $$$$@)/.
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@
 
 $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.hc includes/ghcautoconf.h includes/ghcplatform.h
-	"$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@
+	"$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@
 
 # $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)hc
 # 	"$$($1_$2_HC)" $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@
diff --git a/rules/package-config.mk b/rules/package-config.mk
index 2091779d1e..177ca2517d 100644
--- a/rules/package-config.mk
+++ b/rules/package-config.mk
@@ -16,6 +16,12 @@ $(call trace, package-config($1,$2,$3))
 $(call profStart, package-config($1,$2,$3))
 
 $1_$2_HC = $$(GHC_STAGE$3)
+$1_$2_CC = $$(CC_STAGE$3)
+$1_$2_AS = $$(AS_STAGE$3)
+$1_$2_AR = $$(AR_STAGE$3)
+$1_$2_AR_OPTS = $$(AR_OPTS_STAGE$3)
+$1_$2_EXTRA_AR_ARGS = $$(EXTRA_AR_ARGS_STAGE$3)
+$1_$2_ArSupportsAtFile = $$(ArSupportsAtFile_STAGE$3)
 
 # configuration stuff that depends on which GHC we're building with
 ifeq "$3" "0"
diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk
index 64339576c6..5cc10dc347 100644
--- a/rules/shell-wrapper.mk
+++ b/rules/shell-wrapper.mk
@@ -74,7 +74,6 @@ install_$1_$2_wrapper:
 	echo 'datadir="$$(datadir)"'                             >> "$$(WRAPPER)"
 	echo 'bindir="$$(bindir)"'                               >> "$$(WRAPPER)"
 	echo 'topdir="$$(topdir)"'                               >> "$$(WRAPPER)"
-	echo 'pgmgcc="$$(WhatGccIsCalled)"'                      >> "$$(WRAPPER)"
 	$$($1_$2_SHELL_WRAPPER_EXTRA)
 	$$($1_$2_INSTALL_SHELL_WRAPPER_EXTRA)
 	cat $$($1_$2_SHELL_WRAPPER_NAME)                         >> "$$(WRAPPER)"
diff --git a/settings.in b/settings.in
new file mode 100644
index 0000000000..5d4e1d3a76
--- /dev/null
+++ b/settings.in
@@ -0,0 +1,8 @@
+[("GCC extra via C opts", "@GccExtraViaCOpts@"),
+ ("C compiler command", "@WhatGccIsCalled@"),
+ ("C compiler flags", "@CONF_CC_OPTS_STAGE2@"),
+ ("ar command", "@ArCmd@"),
+ ("ar flags", "@ArArgs@"),
+ ("ar supports at file", "@ArSupportsAtFile@"),
+ ("perl command", "@PerlCmd@")]
+
diff --git a/sync-all b/sync-all
index 02ac5214b2..5dc6a40953 100755
--- a/sync-all
+++ b/sync-all
@@ -65,13 +65,9 @@ my $defaultrepo;
 my @packages;
 my $verbose = 2;
 my $ignore_failure = 0;
-my $want_remote_repo = 0;
 my $checked_out_flag = 0;
 my $get_mode;
 
-# Flags specific to a particular command
-my $local_repo_unnecessary = 0;
-
 my %tags;
 
 # Figure out where to get the other repositories from.
@@ -195,17 +191,6 @@ sub scm {
     }
 }
 
-sub repoexists {
-    my ($scm, $localpath) = @_;
-    
-    if ($scm eq "darcs") {
-        -d "$localpath/_darcs";
-    }
-    else {
-        -d "$localpath/.git";
-    }
-}
-
 sub scmall {
     my $command = shift;
     
@@ -221,8 +206,6 @@ sub scmall {
     my $path;
     my $wd_before = getcwd;
 
-    my @scm_args;
-
     my $pwd;
     my @args;
 
@@ -253,7 +236,7 @@ sub scmall {
         } else {
             $branch_name = shift;
         }
-    } elsif ($command eq 'new' || $command eq 'fetch') {
+    } elsif ($command eq 'new') {
         if (@_ < 1) {
             $branch_name = 'origin';
         } else {
@@ -265,137 +248,162 @@ sub scmall {
 
     for $line (@packages) {
 
-            $localpath  = $$line{"localpath"};
-            $tag        = $$line{"tag"};
-            $remotepath = $$line{"remotepath"};
-            $scm        = $$line{"vcs"};
-            $upstream   = $$line{"upstream"};
+        $localpath  = $$line{"localpath"};
+        $tag        = $$line{"tag"};
+        $remotepath = $$line{"remotepath"};
+        $scm        = $$line{"vcs"};
+        $upstream   = $$line{"upstream"};
 
-            # We can't create directories on GitHub, so we translate
-            # "package/foo" into "package-foo".
-            if ($is_github_repo) {
-                $remotepath =~ s/\//-/;
-            }
+        # Check the SCM is OK as early as possible
+        die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
 
-            # Check the SCM is OK as early as possible
-            die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
+        # We can't create directories on GitHub, so we translate
+        # "package/foo" into "package-foo".
+        if ($is_github_repo) {
+            $remotepath =~ s/\//-/;
+        }
 
-            # Work out the path for this package in the repo we pulled from
-            if ($checked_out_tree) {
-                $path = "$repo_base/$localpath";
-            }
-            else {
-                $path = "$repo_base/$remotepath";
-            }
+        # Work out the path for this package in the repo we pulled from
+        if ($checked_out_tree) {
+            $path = "$repo_base/$localpath";
+        }
+        else {
+            $path = "$repo_base/$remotepath";
+        }
 
-            # Work out the arguments we should give to the SCM
-            if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
-                @scm_args = (($scm eq "darcs" and "whatsnew")
-                          or ($scm eq "git" and "status"));
-                
-                # Hack around 'darcs whatsnew' failing if there are no changes
-                $ignore_failure = 1;
-            }
-            elsif ($command =~ /^commit$/) {
-                @scm_args = ("commit");
-                # git fails if there is nothing to commit, so ignore failures
-                $ignore_failure = 1;
+        if ($command =~ /^(?:g|ge|get)$/) {
+            # Skip any repositories we have not included the tag for
+            if (not defined($tags{$tag})) {
+                $tags{$tag} = 0;
             }
-            elsif ($command =~ /^(?:pus|push)$/) {
-                @scm_args = "push";
+            if ($tags{$tag} == 0) {
+                next;
             }
-            elsif ($command =~ /^(?:pul|pull)$/) {
-                @scm_args = "pull";
-                # Q: should we append the -a argument for darcs repos?
-            }
-            elsif ($command =~ /^(?:g|ge|get)$/) {
-                # Skip any repositories we have not included the tag for
-                if (not defined($tags{$tag})) {
-                    next;
-                }
-                
-                if (-d $localpath) {
-                    warning("$localpath already present; omitting") if $localpath ne ".";
-                    next;
+            
+            if (-d $localpath) {
+                warning("$localpath already present; omitting")
+                    if $localpath ne ".";
+                if ($scm eq "git") {
+                    scm ($localpath, $scm, "config", "core.ignorecase", "true");
                 }
-                
+                next;
+            }
+
+            # Note that we use "." as the path, as $localpath
+            # doesn't exist yet.
+            if ($scm eq "darcs") {
                 # The first time round the loop, default the get-mode
-                if ($scm eq "darcs" && not defined($get_mode)) {
+                if (not defined($get_mode)) {
                     warning("adding --partial, to override use --complete");
                     $get_mode = "--partial";
                 }
-                
-                # The only command that doesn't need a repo
-                $local_repo_unnecessary = 1;
-                
-                if ($scm eq "darcs") {
-                    # Note: we can only use the get-mode with darcs for now
-                    @scm_args = ("get", $get_mode, $path, $localpath);
-                }
-                else {
-                    @scm_args = ("clone", $path, $localpath);
-                }
-            }
-            elsif ($command =~ /^(?:s|se|sen|send)$/) {
-                @scm_args = (($scm eq "darcs" and "send")
-                          or ($scm eq "git" and "send-email"));
-                $want_remote_repo = 1;
-            }
-            elsif ($command =~ /^fetch$/) {
-                @scm_args = ("fetch", "$branch_name");
-            }
-            elsif ($command =~ /^new$/) {
-                @scm_args = ("log", "$branch_name..");
+                scm (".", $scm, "get", $get_mode, $path, $localpath, @args);
             }
-            elsif ($command =~ /^remote$/) {
-                if ($subcommand eq 'add') {
-                    @scm_args = ("remote", "add", $branch_name, $path);
-                } elsif ($subcommand eq 'rm') {
-                    @scm_args = ("remote", "rm", $branch_name);
-                } elsif ($subcommand eq 'set-url') {
-                    @scm_args = ("remote", "set-url", $branch_name, $path);
-                }
+            else {
+                scm (".", $scm, "clone", $path, $localpath, @args);
+                scm ($localpath, $scm, "config", "core.ignorecase", "true");
             }
-            elsif ($command =~ /^grep$/) {
-              @scm_args = ("grep");
-              # Hack around 'git grep' failing if there are no matches
-              $ignore_failure = 1;
+            next;
+        }
+
+        if (-d "$localpath/_darcs") {
+            if (-d "$localpath/.git") {
+                die "Found both _darcs and .git in $localpath";
             }
-            elsif ($command =~ /^reset$/) {
-                @scm_args = "reset";
+            $scm = "darcs";
+        } elsif (-d "$localpath/.git") {
+            $scm = "git";
+        } elsif ($tag eq "") {
+            die "Required repo $localpath is missing";
+        } else {
+             message "== $localpath repo not present; skipping";
+             next;
+        }
+
+        # Work out the arguments we should give to the SCM
+        if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
+            if ($scm eq "darcs") {
+                $command = "whatsnew";
             }
-            elsif ($command =~ /^config$/) {
-                @scm_args = "config";
+            elsif ($scm eq "git") {
+                $command = "status";
             }
             else {
-                die "Unknown command: $command";
+                die "Unknown scm";
             }
-            
-            # Actually execute the command
-            if (repoexists ($scm, $localpath)) {
-                if ($want_remote_repo) {
-                    if ($scm eq "darcs") {
-                        scm (".", $scm, @scm_args, @args, "--repodir=$localpath", $path);
-                    } else {
-                        # git pull doesn't like to be used with --work-dir
-                        # I couldn't find an alternative to chdir() here
-                        scm ($localpath, $scm, @scm_args, @args, $path, "master");
-                    }
-                } else {
-                    # git status *must* be used with --work-dir, if we don't chdir() to the dir
-                    scm ($localpath, $scm, @scm_args, @args);
-                }
-            }
-            elsif ($local_repo_unnecessary) {
-                # Don't bother to change directory in this case
-                scm (".", $scm, @scm_args, @args);
+
+            # Hack around 'darcs whatsnew' failing if there are no changes
+            $ignore_failure = 1;
+            scm ($localpath, $scm, $command, @args);
+        }
+        elsif ($command =~ /^commit$/) {
+            # git fails if there is nothing to commit, so ignore failures
+            $ignore_failure = 1;
+            scm ($localpath, $scm, "commit", @args);
+        }
+        elsif ($command =~ /^(?:pus|push)$/) {
+            scm ($localpath, $scm, "push", @args);
+        }
+        elsif ($command =~ /^(?:pul|pull)$/) {
+            scm ($localpath, $scm, "pull", @args);
+        }
+        elsif ($command =~ /^(?:s|se|sen|send)$/) {
+            if ($scm eq "darcs") {
+                $command = "send";
             }
-            elsif ($tag eq "") {
-                message "== Required repo $localpath is missing! Skipping";
+            elsif ($scm eq "git") {
+                $command = "send-email";
             }
             else {
-                message "== $localpath repo not present; skipping";
+                die "Unknown scm";
             }
+            scm ($localpath, $scm, $command, @args);
+        }
+        elsif ($command =~ /^fetch$/) {
+            scm ($localpath, $scm, "fetch", @args);
+        }
+        elsif ($command =~ /^new$/) {
+            my @scm_args = ("log", "$branch_name..");
+            scm ($localpath, $scm, @scm_args, @args);
+        }
+        elsif ($command =~ /^remote$/) {
+            my @scm_args;
+            if ($subcommand eq 'add') {
+                @scm_args = ("remote", "add", $branch_name, $path);
+            } elsif ($subcommand eq 'rm') {
+                @scm_args = ("remote", "rm", $branch_name);
+            } elsif ($subcommand eq 'set-url') {
+                @scm_args = ("remote", "set-url", $branch_name, $path);
+            }
+            scm ($localpath, $scm, @scm_args, @args);
+        }
+        elsif ($command =~ /^checkout$/) {
+            # Not all repos are necessarily branched, so ignore failure
+            $ignore_failure = 1;
+            scm ($localpath, $scm, "checkout", @args)
+                unless $scm eq "darcs";
+        }
+        elsif ($command =~ /^grep$/) {
+            # Hack around 'git grep' failing if there are no matches
+            $ignore_failure = 1;
+            scm ($localpath, $scm, "grep", @args)
+                unless $scm eq "darcs";
+        }
+        elsif ($command =~ /^clean$/) {
+            scm ($localpath, $scm, "clean", @args)
+                unless $scm eq "darcs";
+        }
+        elsif ($command =~ /^reset$/) {
+            scm ($localpath, $scm, "reset", @args)
+                unless $scm eq "darcs";
+        }
+        elsif ($command =~ /^config$/) {
+            scm ($localpath, $scm, "config", @args)
+                unless $scm eq "darcs";
+        }
+        else {
+            die "Unknown command: $command";
+        }
     }
 }
 
@@ -421,7 +429,9 @@ Supported commands:
  * remote add <branch-name>
  * remote rm <branch-name>
  * remote set-url [--push] <branch-name>
+ * checkout
  * grep
+ * clean
  * reset
  * config
 
@@ -484,9 +494,11 @@ sub main {
         }
         # --<tag> says we grab the libs tagged 'tag' with
         # 'get'. It has no effect on the other commands.
-        elsif ($arg =~ m/^--/) {
-            $arg =~ s/^--//;
-            $tags{$arg} = 1;
+        elsif ($arg =~ m/^--no-(.*)$/) {
+            $tags{$1} = 0;
+        }
+        elsif ($arg =~ m/^--(.*)$/) {
+            $tags{$1} = 1;
         }
         else {
             unshift @_, $arg;
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 72a5010f80..d64c2240a8 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -28,7 +28,8 @@ import System.Exit
 import System.FilePath
 
 main :: IO ()
-main = do args <- getArgs
+main = do hSetBuffering stdout LineBuffering
+          args <- getArgs
           case args of
               "hscolour" : distDir : dir : args' ->
                   runHsColour distDir dir args'
diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs
index a25537ee99..b3ed58f327 100644
--- a/utils/ghctags/Main.hs
+++ b/utils/ghctags/Main.hs
@@ -10,6 +10,7 @@ import DriverPhases     ( isHaskellSrcFilename )
 import HscTypes         ( msHsFilePath )
 import Name             ( getOccString )
 --import ErrUtils         ( printBagOfErrors )
+import Panic            ( panic )
 import DynFlags         ( defaultDynFlags )
 import Bag
 import Exception
@@ -100,7 +101,7 @@ main = do
                      then Just `liftM` openFile "TAGS" openFileMode
                      else return Nothing
 
-  GHC.defaultErrorHandler defaultDynFlags $
+  GHC.defaultErrorHandler (defaultDynFlags (panic "No settings")) $
     runGhc (Just ghc_topdir) $ do
       --liftIO $ print "starting up session"
       dflags <- getSessionDynFlags
diff --git a/validate b/validate
index 8d6e2c3043..b1ae14ffec 100755
--- a/validate
+++ b/validate
@@ -73,7 +73,7 @@ if [ $no_clean -eq 0 ]; then
         INSTDIR=`cygpath -m "$INSTDIR"`
     fi
 
-    /usr/bin/perl -w boot --required-tag=dph
+    /usr/bin/perl -w boot --validate --required-tag=dph
     ./configure --prefix="$INSTDIR" $config_args
 fi